Dan Waters
df.waters at comcast.net
Thu Feb 24 12:37:30 CST 2011
Thanks John! Of course now that I have this I'll probably remember not to lock myself out anymore. ;-) Dan -----Original Message----- From: accessd-bounces at databaseadvisors.com [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of jwcolby Sent: Thursday, February 24, 2011 8:25 AM To: Access Developers discussion and problem solving Subject: Re: [AccessD] How To Undo Disabled Shift Bypass Good job Dan. I have an access database that does that. It allows you to navigate to and select an access database to set all of those properties on (and there a bunch of them). John W. Colby www.ColbyConsulting.com On 2/24/2011 8:40 AM, 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 > > '------------------------ > > > > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com