数据库属性

将以下代码添加为标准模块后，可以轻松使用和操纵数据库的属性：

Option Compare Database
Option Explicit 
Private Const conNoProp As Integer = 3270
Private Const conVBToDB As String = "\2|3\3|4\4|6\5|7\6|5" & _
                                    "\7|8\8|10\11|1\14|20\17|2" 
'SetProperty() requires that either intPType is set explicitly OR that
'              varPVal has a valid value if a new property is to be created.
Public Sub SetProperty(strPName As String _
                     , varPVal As Variant _
                     , Optional ByVal objVar As Object _
                     , Optional intPType As Integer = -1)
    Dim prpVal As DAO.Property 
    Call SetObj(objVar)
    If PropertyExists(strPName, objVar) Then
        objVar.Properties(strPName) = varPVal
    Else
        If intPType = -1 Then intPType = DBVal(VarType(varPVal))
        Set prpVal = objVar.CreateProperty(strPName, intPType, varPVal)
        Call objVar.Properties.Append(prpVal)
    End If
End Sub 
'GetProperty() returns the value of the specified property if found.
Public Function GetProperty(ByRef strPName As String, _
                            Optional ByVal objVar As Object) As Variant
    Call SetObj(objVar)
    If PropertyExists(strPName, objVar) Then _
        GetProperty = objVar.Properties(strPName)
End Function 
'PropertyExists() returns True if the property exists and False if it doesn't.
Public Function PropertyExists(ByRef strPName As String _
                             , Optional ByVal objVar As Object) As Boolean
    Dim varTest As Variant 
    On Error GoTo ErrorHandler
    Call SetObj(objVar)
    PropertyExists = True
    varTest = objVar.Properties(strPName)
    Exit Function 
ErrorHandler:
    If Err <> conNoProp Then
        On Error GoTo 0
        Resume
    End If
    PropertyExists = False
End Function 
'DelProperty() deletes the property if it exists.
Public Sub DelProperty(ByRef strPName As String _
                     , Optional ByVal objVar As Object)
    Call SetObj(objVar)
    If Not PropertyExists(strPName, objVar) Then Exit Sub
    Call objVar.Properties.Delete(strPName)
End Sub 
'SetObj() sets objVar to CurrentDb() if it's not already set.
Private Sub SetObj(ByRef objVar As Object)
    If objVar Is Nothing Then Set objVar = CurrentDb()
End Sub 
'DBVal() returns the value of the Type that is used in DAO
'  from the VBA equivalent.
Private Function DBVal(intVBVal) As Integer
    Dim intX As Integer 
    intX = InStr(1, conVBToDB, "\" & intVBVal & "|")
    DBVal = Val(Mid(conVBToDB, intX + Len(intVBVal) + 2))
End Function

如果需要确定哪些命名属性已可用于数据库，则从VBA IDE窗口的立即窗格运行的以下代码将为您显示它们：

Set db = CurrentDb : For Each prp in db.Properties : ?prp.Name : Next prp

From: https://bytes.com/topic/access/insights/929840-database-properties