VBA: Robust Database creation - database

Question

i find this code, when trying to create db, using adodb and 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
But how to make it more robust, so, i don't want to delete db.
How to check, if db exists and if db.tables contains my table?
additional question: am i right, that this code create db for ms-access 2007?
Thanks for help!

Answer 1

Your question includes these two:
How to check, if db exists and if db.tables contains my table?
am i right, that this code create db for ms-access 2007?
For the first part of #1, use the Dir() function.
If Len(Dir("C:\SomeFolder\YourDb.mdb")) > 0 Then
Debug.Print "db exists"
Else
Debug.Print "db not found"
End If
For the second part of #1, try this function. pTable is the name of the table you're checking for. pDbPath is the full path, including the file name, for the db file you want to examine. The path can be one which begins with a drive letter, or it can be a UNC path ( \\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
Regarding your second question, no that code you showed us does not create a db file for any Access version. If db_file is not the path to an existing db file, that code will throw an error at conn.Open. It does not create the missing db file.
However I doubt that code will compile as VBA, despite the fact you included VBA in your title and tagged your question as vba. Really you should have at least tried it first before including it in a question on Stack Overflow.

Answer 2

For creating a MDB file from VB6/VBA code you could use ADOX. Here's a sample function to create an MDB file.
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