Function CreatePassWordDB(strPathName As String, strPsd As String) As Boolean On Error GoTo Exit_ERR Dim wrkDefault As Workspace Dim NewDB As Database
CreatePassWordDB = False Set wrkDefault = DBEngine.Workspaces(0) If Dir(strPathName) <> "" Then Kill strPathName Set NewDB = wrkDefault.CreateDatabase(strPathName, dbLangGeneral &. ".pwd=" &. strPsd &. "")
NewDB.Close Set NewDB = Nothing
CreatePassWordDB = True Exit Function Exit_ERR: MsgBox "备份失败!" &. vbCrLf &. vbCrLf &. Err.Description, vbExclamation Exit Function End Function