i have the code below, it sets a bunch of properties based on various tables startup form, toolbars, shift bypass, etc
it worked fine for months, now, all of a sudden, all my dbs are opening with errors (so, corruption can't be the cause) what's weird is that it works fine on a different computer what can be wrong with the one that errors? i restarted
it errors at s = CurrentDb.Properties(sPropName).Name
here's all 3 functions
Sub sbSetStartupOptions()
Dim bOn As Boolean
SetOption "Auto Compact", True
SetOption "Show Hidden Objects", False
SetOption "Show System Objects", False
SetOption "Confirm Record Changes", True
SetOption "Confirm Document Deletions", True
SetOption "Confirm Action Queries", True
SetOption "Default Open Mode for Databases", 0 'shared
SetOption "ShowWindowsInTaskbar", False
sbAppIcon
Dim vrAppName As String
Dim vrStartupForm As String
vrStartupForm = DLookup("StartupForm", "zAppSettings", "AppSettingsID=1")
fnSetDatabaseProperty "StartupForm", 1, vrStartupForm
vrAppName = DLookup("AppName", "zAppSettings", "AppSettingsID=1")
fnChangeAppNameCurrentDB (vrAppName)
fnSetDatabaseProperty "StartupShowStatusBar", 1, True '1=dbBoolean
bOn = fnIsDev
fnSetDatabaseProperty "AllowShortcutMenus", 1, bOn
fnSetDatabaseProperty "StartupShowDBWindow", 1, bOn
fnSetDatabaseProperty "AllowToolbarChanges", 1, bOn
fnSetDatabaseProperty "AllowBreakIntoCode", 1, bOn
fnSetDatabaseProperty "AllowSpecialKeys", 1, bOn
fnSetDatabaseProperty "AllowBypassKey", 1, bOn
fnSetDatabaseProperty "AllowFullMenus", 1, bOn
fnSetDatabaseProperty "AllowBuiltinToolbars", 1, bOn
Application.SetHiddenAttribute acTable, "zLockReleaseDatabase", Not bOn
End Sub
Function fnSetDatabaseProperty(ByVal sPropName As String, Optional ByVal lngPropType As Long, Optional vPropValue As Variant) As Boolean
Dim s As String, bCreate As Boolean
On Error Resume Next
If CurrentProject.ProjectType = acADP Then
s = CurrentProject.Properties(sPropName).Name
Else
s = CurrentDb.Properties(sPropName).Name
End If
If Err.Number > 0 Then bCreate = True
On Error GoTo P_Error
If bCreate Then
If Not IsMissing(vPropValue) Then
If CurrentProject.ProjectType = acADP Then
CurrentProject.Properties.Add sPropName, vPropValue
Else
If lngPropType = 0 Then lngPropType = varType(vPropValue)
CurrentDb.Properties.Append CurrentDb.CreateProperty(sPropName, lngPropType, vPropValue)
End If
End If
Else
If IsMissing(vPropValue) Then
If CurrentProject.ProjectType = acADP Then
CurrentProject.Properties.Remove sPropName
Else
CurrentDb.Properties.Delete sPropName
End If
Else
If CurrentProject.ProjectType = acADP Then
CurrentProject.Properties(sPropName).Value = vPropValue
Else
CurrentDb.Properties(sPropName).Value = vPropValue
End If
End If
End If
If Not CurrentProject.ProjectType = acADP Then
CurrentDb.Properties.Refresh
End If
fnSetDatabaseProperty = True
P_Exit:
Exit Function
P_Error:
'GetError Err.Number, Err.description, Erl, CurrentObjectName, "SetDatabaseProperty"
Resume P_Exit
End Function
Function fnSetProperties(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error GoTo Err_SetProperties
Dim db As DAO.database, prp As DAO.Property
Set db = CurrentDb
db.Properties(strPropName) = varPropValue
fnSetProperties = True
Set db = Nothing
Exit_SetProperties:
Exit Function
Err_SetProperties:
If Err = 3270 Then 'Property not found
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
fnSetProperties = False
MsgBox "SetProperties", Err.Number, Err.Description
Resume Exit_SetProperties
End If
End Function
You understand that attempting to reference a property which does not exist triggers error #3270, "Property not found." And you expect to suppress the display of that error message when you include On Error Resume Next
before referencing the property.
However, although your code includes On Error Resume Next
before s = CurrentDb.Properties(sPropName).Name
, Access still displayed the error message whenever property sPropName
did not exist.
The only way I could find to replicate that behavior is by setting Access' Error Trapping option to "Break on All Errors" With that setting, the following simple procedure displays the "Property not found" error message despite On Error Resume Next
--- the same situation you're dealing with. It appears "Break on All Errors" trumps On Error Resume Next
.
Public Sub test_04()
Dim s As String
Dim sPropName As String
sPropName = "BOGUS" ' no such property exists in my database
On Error Resume Next
s = CurrentDb.Properties(sPropName).Name
End Sub
If I change my Error Trapping option to either "Break in Class Module" or "Break on Unhandled Errors", that procedure does not display the error message. With those options, the behavior is determined by On Error Resume Next
--- the code continues on without displaying an error message.