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