|
本帖最后由 鱼儿游游 于 2011-5-18 15:46 编辑
SaveDbSetting , "AppTitle", DB_TEXT, "上面的标题内容"
Function SaveDbSetting(Optional DatabaseName As String = "", _
Optional PropertyName As String = "AllowByPassKey", _
Optional DataType As conDataTypeEnum = DB_BOOLEAN, _
Optional Value As Variant = False) As Boolean
On Error GoTo Err_SaveDbSetting
Dim dbs As Variant
Dim prp As Variant
If Trim$(DatabaseName) <> "" Then
Set dbs = DBEngine.OpenDatabase(DatabaseName)
Else
Set dbs = CurrentDb
End If
Select Case DataType
Case DB_BOOLEAN
Value = CBool(Value)
Case DB_LONG
Value = CLng(Value)
Case DB_TEXT
Value = CStr(Value)
End Select
If Value = "" Then Value = Space$(1)
dbs.Properties(PropertyName) = Value
SaveDbSetting = True
Exit_SaveDbSetting:
Exit Function
Err_SaveDbSetting:
' 属性未找时创建该属性
If err = 3270 Then
Set prp = dbs.CreateProperty(PropertyName, DataType, Value)
dbs.Properties.Append prp
Else
SaveDbSetting = False
MsgBox "Error For Function SaveDbSetting()" & vbCr & err.Description, vbCritical
Resume Exit_SaveDbSetting
End If
End Function
|
|