[blue]Public Function CreateDBProp(prpName As String, prpDatTyp As Long, _
prpVal) As Boolean
'prpDatTyp: dbBoolean, dbByte, dbCurrency, dbDate, dbDecimal, dbDouble,
' dbFloat, dbInteger, dbLong, dbMemo, dbSingle, dbText
On Error GoTo GotErr
Dim db As DAO.Database, prp As Property
Dim Msg As String, Style As Integer, Title As String
If IsEmpty(GetDBProp(prpName)) Then
Set db = CurrentDb
Set prp = db.CreateProperty(prpName, prpDatTyp, prpVal)
db.Properties.Append prp
CreateDBProp = True
Else
Msg = "The property '" & prpName & "' Already Exists!"
Style = vbInformation + vbOKOnly
Title = "Can't Create . . . Property Exists!"
MsgBox Msg, Style, Title
End If
SeeYa:
Set prp = Nothing
Set db = Nothing
Exit Function
GotErr:
Call PropErrMsg
Resume SeeYa
End Function
Public Function GetDBProp(prpName As String)
'Always assign GetDBProp to Variant data type.
'Returns Empty if property not found.
'Use IsEmpty() to determine if property exists.
Dim Msg As String, Style As Integer, Title As String
On Error GoTo GotErr
GetDBProp = CurrentDb.Properties(prpName)
GotErr:
End Function
Public Function SetDBProp(prpName As String, prpVal) As Boolean
On Error GoTo GotErr
Dim Msg As String, Style As Integer, Title As String
If IsEmpty(GetDBProp(prpName)) Then
Msg = "The property '" & prpName & "' Doesn't Exists!"
Style = vbInformation + vbOKOnly
Title = "Property Doesn't Exists! . . ."
MsgBox Msg, Style, Title
Else
CurrentDb.Properties(prpName) = prpVal
SetDBProp = True
End If
SeeYa:
Exit Function
GotErr:
Call PropErrMsg
End Function
Public Function DelDBProp(prpName As String) As Boolean
On Error GoTo GotErr
Dim db As DAO.Database, prp As Property
Dim Msg As String, Style As Integer, Title As String
If IsEmpty(GetDBProp(prpName)) Then
Msg = "The property '" & prpName & "' Doesn't Exists!"
Style = vbInformation + vbOKOnly
Title = "Property Doesn't Exists! . . ."
MsgBox Msg, Style, Title
Else
Set db = CurrentDb
Set prp = db.Properties(prpName)
db.Properties.Delete (prp.Name)
DelDBProp = True
End If
SeeYa:
Set prp = Nothing
Set db = Nothing
Exit Function
GotErr:
Call PropErrMsg
Resume SeeYa
End Function
Public Function CurTax()
CurTax = GetDBProp("TaxRate")
End Function
Public Sub PropErrMsg()
Dim Msg As String, Style As Integer, Title As String
Msg = "Error " & Err.Number & ": " & Err.Description
Style = vbCritical + vbOKOnly
Title = "System Error! . . ."
MsgBox Msg, Style, Title
End Sub[/blue]