Tony Septav
iggy at nanaimo.ark.com
Fri Feb 25 08:50:54 CST 2011
Hey Dan Ha ha ha ha ha ha ha ha ha !. This should have been OT: Friday Humour. That is the best I have heard, a developer locking themselves out of their own application. Just kidding I think we have all run into it at one time or another, trying to lock down what a user can do in an app. I know I did it myself a couple of years ago and spent several hours going "Oh crap Oh crap" until the "Duh" light came on and luckily I was able to copy it. Not a nice feeling. Dan Waters wrote: >Sure been quiet for a few days! So this is something I finished yesterday. > >A few days ago, for about the hundredth time, I accidentally locked myself >out of an Access file by mistakenly running code to change its properties, >including setting the AllowShiftBypass property to False. The normal way to >fix this is to open a new Access file and import all the objects, then reset >references, startup properties, and options. It’s a pain. > >I recently did some work with OpenCurrentDatabase, and wondered if I could >make a utility to reset an Access file’s properties where that file had its >properties set to False. And it worked! > >Below is code that you can copy into a standard module in a new Access >file. Name that new file AllowBypass.mdb, or something similar. Run the >first procedure – this will ask you to select an Access file, and it will >then reset several properties to true so that you can open it normally >again. > >Hope someone can use this! >Dan > >‘------------------------ >Private MappSource As Access.Application > >Private Sub UnlockMDB() >1 On Error GoTo EH > > '-- Note: Run this application from this procedure. > > Dim stgSourceFilePath As String > Dim stgPrompt As String > > '-- Select Access File >2 stgSourceFilePath = SelectFile >3 If stgSourceFilePath = "File Not Selected" Or stgSourceFilePath = >"" Then >4 MsgBox "Can't find file!", vbExclamation + vbOKOnly, "No File" >5 Exit Sub >6 End If >7 DoEvents > > '-- Set Source MDB as the CurrentDatabase >8 Set MappSource = New Access.Application >9 MappSource.Visible = False >10 MappSource.OpenCurrentDatabase stgSourceFilePath >11 DoEvents > >12 ChangeProperty "AllowBypassKey", dbBoolean, True '-- Allow shift >key bypass >13 ChangeProperty "AllowSpecialKeys", dbBoolean, True '-- Allow F11 >key >14 ChangeProperty "AllowBreakIntoCode", dbBoolean, True >15 ChangeProperty "AllowFullMenus", dbBoolean, True >16 ChangeProperty "StartupShowDBWindow", dbBoolean, True > >17 MappSource.CloseCurrentDatabase >18 Set MappSource = Nothing > >19 MsgBox "Your file at " & stgSourceFilePath & " is now available!", >vbInformation + vbOKOnly, "File Now Available" > >20 Exit Sub > >EH: >21 stgPrompt = "ERROR: SelectFile" & vbNewLine & vbNewLine _ > & "Line: " & Erl & vbNewLine _ > & "Number: " & Err.Number & vbNewLine _ > & "Description: " & Err.Description >22 MsgBox stgPrompt, vbExclamation + vbOKOnly >23 Stop > >End Sub > >Private Function SelectFile() As String >1 On Error GoTo EH > > Dim fDialog As Office.FileDialog > Dim stgPrompt As String > Dim varFile As Variant > >2 Set fDialog = FileDialog(msoFileDialogFilePicker) > >3 With fDialog > >4 .AllowMultiSelect = False >5 .InitialView = msoFileDialogViewList >6 .InitialFileName = CurrentProject.Path >7 .Title = "Select the Access file." > >8 .Filters.Clear >9 .Filters.Add "Access Databases", "*.MDB" > '.Filters.Add "Access Projects", "*.ADP" > > '-- Show the dialog box. If the .Show method returns True, the >_ > user picked at least one file. If the .Show method returns >_ > False, the user clicked Cancel. >10 If .Show = True Then >11 For Each varFile In .SelectedItems >12 SelectFile = varFile >13 Next varFile >14 Else >15 SelectFile = "File Not Selected" >16 End If > >17 End With > >18 Exit Function > >EH: >19 stgPrompt = "ERROR: SelectFile" & vbNewLine & vbNewLine _ > & "Line: " & Erl & vbNewLine _ > & "Number: " & Err.Number & vbNewLine _ > & "Description: " & Err.Description >20 MsgBox stgPrompt, vbExclamation + vbOKOnly >21 Stop > >End Function > >Public Function ChangeProperty(stgPropName As String, varPropType As >Variant, varPropValue As Variant) As Boolean >1 On Error GoTo EH > > Dim prp As DAO.Property > Dim stgPrompt As String > Dim dbs As DAO.Database > >2 Set dbs = MappSource.DBEngine(0)(0) > >3 dbs.Properties(stgPropName) = varPropValue > > ' For Each prp In dbs.Properties > ' If prp.Name = "AllowBypassKey" = True Then > ' Debug.Print prp.Name > ' Debug.Print prp.Type > ' Debug.Print prp.Value > ' Debug.Print > ' End If > ' Next prp > >4 ChangeProperty = True > >XH: >5 Exit Function > >EH: >6 Select Case Err.Number > > Case 3270 > '-- Add property if not already created >7 Set prp = DBEngine(0)(0).CreateProperty(stgPropName, >varPropType, varPropValue) >8 DBEngine(0)(0).Properties.Append prp >9 Set prp = Nothing >10 Resume Next > >11 Case Else >12 stgPrompt = "ERROR: SelectFile" & vbNewLine & vbNewLine _ > & "Line: " & Erl & vbNewLine _ > & "Number: " & Err.Number & vbNewLine _ > & "Description: " & Err.Description >13 MsgBox stgPrompt, vbExclamation + vbOKOnly >14 Stop > >15 End Select > >End Function > >‘------------------------ > > > > > >