创建一个空数据库

　　 

　　Function CreateNormalDB(strPathName As String) As Boolean

　　On Error GoTo Exit_ERR

　　Dim wrkDefault As Workspace

　　Dim NewDB As Database　　

　　CreateNormalDB = False

　　Set wrkDefault = DBEngine.Workspaces(0)

　　If Dir(strPathName) <> "" Then Kill strPathName

　　Set NewDB = wrkDefault.CreateDatabase(strPathName, dbLangGeneral)　　

　　NewDB.Close

　　Set NewDB = Nothing

　　CreateNormalDB = True

　　Exit Function

　　Exit_ERR:

　　MsgBox "备份失败！" & vbCrLf & vbCrLf & Err.Description, vbExclamation

　　Exit Function

　　End Function　　

　　'调用时只需提供路径及文件名即可，此函数为备份数据模块的一部份

原文转自：http://www.ltesting.net