VBA/Excel/Access/Word/Access/Database Properties

Changing Options

 
Public Sub setOptions()
   With Application
      .SetOption "show status bar", False
      .SetOption "show startup dialog box", False
   End With
End Sub

Database properties: AllowFullMenus, Allowtoolbarchanges

 
Public Sub startupProperties()
   Dim myDatabase As Object
   Set myDatabase = CurrentDb
   myDatabase.Properties("AllowFullMenus") = False
   myDatabase.Properties("Allowtoolbarchanges") = False
   
End Sub

Enumerate the properties of current database

 
Sub EnumDBProperties()
    Dim pty As Property
    Dim strTemp As String
    
    On Error Resume Next
    For Each pty In CurrentDb.Properties
        strTemp = pty.Name & ": "
        strTemp = strTemp & pty.Value
        Debug.Print strTemp
    Next
    
End Sub

reset any values you set

 
Public Sub startupProperties1()
   Dim myDatabase As Object
   Set myDatabase = CurrentDb
   With myDatabase
      .Properties.Delete "AllowFullMenus"
      .Properties.Delete "AllowToolBarChanges"
    End With
    Application.RefreshTitleBar
End Sub

Set new property to database

 
Sub KeepEmOut()
    Dim db As Database
    Dim pty As Property
    On Error GoTo KeepEmOut_Err
    Set db = CurrentDb
    db.Properties("AllowBypassKey").Value = False
KeepEmOut_Exit:
    Exit Sub
KeepEmOut_Err:
    If Err.Number = 3270 Then
        Set pty = db.CreateProperty("AllowBypassKey", dbBoolean, False)
        db.Properties.Append pty
    Else
        Debug.Print Err.Description
        Resume KeepEmOut_Exit
    End If
    
End Sub

Sub KeepEmOut()

 
    Dim db As Database
    Dim pty As Property
    On Error GoTo KeepEmOut_Err
    Set db = CurrentDb
    db.Properties("AllowBypassKey").Value = False
KeepEmOut_Exit:
    Exit Sub
KeepEmOut_Err:
    If Err.Number = 3270 Then       "Error code for "Property not found"...
        "so we"ll create it ourselves
        Set pty = db.CreateProperty("AllowBypassKey", dbBoolean, False)
        db.Properties.Append pty
    Else
        MsgBox Err.Description
        Resume KeepEmOut_Exit
    End If
    
End Sub