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

CodePudding user response：

I have not set a startup form for my database. With the following code sample, the only way I can find to make it ignore On Error Resume Next and throw the "Property not found" error is by changing the VB Editor's Error Trapping option to "Break on All Errors".

Check your Error Trapping setting for one of the problem databases. From the VBE main menu, select Tools -> Options and then choose the General tab. If your setting is "Break on All Errors", change it to "Break on Unhandled Errors". That Error Trapping setting should make your procedure honor the On Error Resume Next directive and therefore eliminate the "Property not found" error notifications.

Public Sub test_04()
    Dim s As String
    Dim sPropName As String

    sPropName = "StartupForm"
    On Error Resume Next
    s = CurrentDb.Properties(sPropName).Name
End Sub