[AccessD] How To Undo Disabled Shift Bypass

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
>
>‘------------------------
>
>
>
>
>  
>




More information about the AccessD mailing list