VBA: Robust Database creation

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!

HansUp · Accepted Answer · 2012-05-07 15:08:59Z

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.

i cut some pieces from that code and glue together. and this work! :) thank you for help!

Cylian · Accepted Answer · 2012-05-07 04:51:55Z

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

Collectives™ on Stack Overflow

VBA: Robust Database creation

2 Answers 2

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related