[AccessD] How To Undo Disabled Shift Bypass

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

‘------------------------