VBA：健壮的数据库创建

Question

我试图创建数据库，使用adodb和adox时，我发现这个代码。

Here you can check original, it is the same. Thanks for author

Private Sub Command1_Click() 
Dim db_file As String 
Dim conn As ADODB.Connection 
Dim rs As ADODB.Recordset 
Dim num_records As Integer 

' Get the database name. 
db_file = App.Path 
If Right$(db_file, 1) <> "\" Then db_file = db_file & _ 
    "\" 
db_file = db_file & "People.mdb" 

' Open a connection. 
Set conn = New ADODB.Connection 
conn.ConnectionString = _ 
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
    "Data Source=" & db_file & ";" & _ 
    "Persist Security Info=False" 
conn.Open 

' Drop the Employees table if it already exists. 
On Error Resume Next 
conn.Execute "DROP TABLE Employees" 
On Error GoTo 0 

' Create the Employees table. 
conn.Execute _ 
    "CREATE TABLE Employees(" & _ 
     "EmployeeId INTEGER  NOT NULL," & _ 
     "LastName VARCHAR(40) NOT NULL," & _ 
     "FirstName VARCHAR(40) NOT NULL)" 

' Populate the table. 
conn.Execute "INSERT INTO Employees VALUES (1, " & _ 
    "'Anderson', 'Amy')" 
conn.Execute "INSERT INTO Employees VALUES (1, 'Baker', " & _ 
    " 'Betty')" 
conn.Execute "INSERT INTO Employees VALUES (1, 'Cover', " & _ 
    " 'Chauncey')" 
' Add more records ... 

' See how many records the table contains. 
Set rs = conn.Execute("SELECT COUNT (*) FROM Employees") 
num_records = rs.Fields(0) 

conn.Close 

MsgBox "Created " & num_records & " records", _ 
    vbInformation, "Done" 
End Sub 

但如何使其更加坚固，所以，我不想删除数据库。

如何检查，如果数据库存在，如果db.tables包含我的表？

附加问题：我是对的，这代码创建数据库为MS访问2007年？

感谢您的帮助！

Answer 1

你的问题包括两个：

1. 如何检查，如果存在分贝，如果db.tables包含我的表？
2. 我说得对，这段代码是为ms-access 2007创建数据库吗？

对于＃1的第一部分，使用Dir（）函数。

If Len(Dir("C:\SomeFolder\YourDb.mdb")) > 0 Then 
    Debug.Print "db exists" 
Else 
    Debug.Print "db not found" 
End If 

对于＃1的第二部分，试试这个功能。 pTable是您正在检查的表的名称。 pDbPath是您要检查的db文件的完整路径，包括文件名。路径可以是以驱动器号开头的路径，也可以是UNC路径（\\ Server \ Share \ YourDb.mdb）。

Public Function TableExists(ByVal pTable As String, _ 
     Optional ByVal pDbPath As String) As Boolean 
    'return True if pTable exists as either a native or linked table ' 
    'pass any error to caller ' 
    Dim blnReturn As Boolean 
    Dim db As DAO.Database 
    Dim tdf As DAO.TableDef 

    If Len(Trim(pDbPath)) > 0 Then 
     Set db = OpenDatabase(pDbPath) 
    Else 
     Set db = CurrentDb 
    End If 

    For Each tdf In db.TableDefs 
     If tdf.Name = pTable Then 
      blnReturn = True 
      Exit For 
     End If 
    Next tdf 

    Set tdf = Nothing 
    If Len(Trim(pDbPath)) > 0 Then 
     db.Close 
    End If 
    Set db = Nothing 
    TableExists = blnReturn 
End Function 

关于你的第二个问题，没有你给我们展示的代码没有为任何Access版本创建一个数据库文件。如果db_file不是现有数据库文件的路径，则该代码将在conn.Open处引发错误。它不会创建缺少的db文件。

但是我怀疑代码会编译为VBA，尽管事实上你在标题中包含了VBA，并且把你的问题标记为vba。真的，你应该至少在将它包含在Stack Overflow的问题中之前先尝试一下。

Answer 2

要从VB6/VBA代码创建MDB文件，您可以使用ADOX。这里有一个示例函数来创建一个MDB文件。

Public Function CreateMDB(strDBPath As String) As Boolean 
'To make code compile add a reference to Microsoft ADO Ext 2.x for DDL and Security 
'(msADOX.dll) 
Dim catDB As ADOX.Catalog 
Dim tblNew As ADOX.Table 
Dim keyPrim As New ADOX.Key 

    Set catDB = New ADOX.Catalog 

    If Dir(strDBPath) = "" Then 
     CreateMDB = False 
    End If 

    With catDB 
     .Create "Provider=Microsoft.Jet.OLEDB.4.0;Locale Identifier=" & _ 
      1033 & ";Data Source=" & strDBPath 
     .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
      "Data Source=" & strDBPath 
    End With 

    Set tblNew = New ADOX.Table 
    With tblNew 
     .Name = "data" 
     With .Columns 
      .Append "Field_0", adVarWChar 
      .Append "Field_1", adVarWChar 
      .Append "Field_2", adVarWChar 
      .Append "Field_3", adVarWChar 
     End With 
    End With 
    catDB.Tables.Append tblNew 

    Set keyPrim = New ADOX.Key 
    With keyPrim 
     .Name = "Field_0" 
     .Type = adKeyPrimary 
     .RelatedTable = "data" 
     .Columns.Append "Field_0" 
    End With 
    catDB.Tables("data").Keys.Append keyPrim 

    Set catDB = Nothing 
    Set tblNew = Nothing 

End Function