VBA: Creating a Trusted Database

Question

I find this code when trying to create db using adodb and adox.

Here you can check the original, it is the same. Thanks to the 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 reliable, so I do not want to remove db.

How to check if db exists, and if db.tables contains my table?

additional question: is it true that this code creates db for ms-access 2007?

Thanks for the help!

Answer 1

Your question includes the following two:

• How to check if db exists and if db.tables contains my table?
• Am I right that this code creates db for ms-access 2007?

For the first part # 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 part two # 1, try this feature. pTable is the name of the table you are checking. pDbPath is the full path, including the file name, for the db file you want to examine. The path can be one that starts 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 

As for your second question, not a single code that you showed us creates a db file for any version of Access. If db_file is not the path to an existing db file, this code throws an error in conn.Open . It does not create the missing db file.

However, I doubt that the code will compile as VBA, despite the fact that you included VBA in your header and marked your question as vba. In fact, you should try it first before including it in the stack overflow question.

Answer 2

You can use ADOX to create an MDB file from VB6 / VBA ADOX . Here is an example function for creating 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