Create Mdb Tables in VBA

Below are some subs and functions to create, delete, and fill tables in a Jet database. I was fiddling with this in order to create a database without using Access, but I ultimately decided to download SQL Server 2005 Express and use it to set up the tables. I’ll still be manipulating the data from Excel, but it’s a lot easier to futz with the fields in a GUI, although I’m struggling to learn SQL Server.

The code to create the table by automating ADOX was provided by

Const Jet10 = 1
Const Jet11 = 2
Const Jet20 = 3
Const Jet3x = 4
Const Jet4x = 5
Sub CreateNewMDB(FileName, Format)
    Dim Catalog As Object
    Set Catalog = CreateObject(“ADOX.Catalog”)
    Catalog.Create “Provider=Microsoft.Jet.OLEDB.4.0;” & _
       “Jet OLEDB:Engine Type=” & Format & _
      “;Data Source=” & FileName
End Sub
Sub MakeJetDB()
    ‘Create Access2000 database
   CreateNewMDB “C:a2000.mdb”, Jet4x
End Sub
Sub CreateTblinDb()
    ‘creates a table in the database
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sSQL As String
    ‘create the table with autonumber, primary key OrderID and
   ‘some other fields
   sSQL = “CREATE TABLE Orders (“ & _
        “OrderID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, “ & _
        “OrderDate date, “ & _
        “CustId char(8), “ & _
        “Amount float)”
    Set cn = New ADODB.Connection
    cn.Open sCON
    cn.Execute sSQL
End Sub
Sub DeleteTblinDb()
    ‘Deletes a table in a database
    Dim cn As ADODB.Connection
    Dim sSQL As String
    ‘deletes the table called Orders
   sSQL = “DROP TABLE Orders”
    Set cn = New ADODB.Connection
    ‘sCON is a constant with a proper connection string
   cn.Open sCON
    cn.Execute sSQL
End Sub
Sub PutDataInTable()
    ‘Puts data from a spreadsheet into a table
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sSQL As String
    Dim rRow As Range
    Dim rRng As Range
    Dim i As Long
    Set rRng = Sheet2.Range(“b2:d4”)
    Set cn = New ADODB.Connection
    cn.Open sCON
    ‘Loops through the rows and builds a SQL statement via a function
   For Each rRow In rRng.Rows
        sSQL = MakeInsertInto(“Orders”, rRow, False, Sheet2.Range(“b1:d1”))
        If Len(sSQL) > 0 Then
            cn.Execute sSQL
        End If
    Next rRow
    Set cn = Nothing
End Sub
Function MakeInsertInto(ByVal sTable As String, _
    ByRef rRecord As Range, _
    Optional ByVal bAutoIncrement As Boolean = True, _
    Optional ByRef rHeader As Range) As String
    ‘Builds a string that’s a SQL statement to insert records into a table
   ‘sTable is the name of the table
   ‘rRecord is the range that contains all the value, one per field
   ‘bAutoIncrement is true if the first field is an autonumber
   ‘rHeader is range that contains the field names – to be used when
   ‘   you’re not inserting all the fields and you need to identify
   ‘   which values are for which fields
    Dim rCell As Range
    Dim sSQL As String
    sSQL = sSQL & “INSERT INTO “ & sTable & ” “
    ‘Add the fields portion of the sql statement if rHeader was supplied
   If Not rHeader Is Nothing Then
        ‘compare cell count of record with header.  If autoincrement, header should be
       ‘one greater than record
       If rRecord.Cells.Count <> rHeader.Cells.Count + CLng(bAutoIncrement) Then
            MakeInsertInto = “”
            Exit Function
        End If
        ‘add column names
       sSQL = sSQL & “(“
        For Each rCell In rHeader.Cells
            sSQL = sSQL & rCell.Value & “, “
        Next rCell
        sSQL = Left$(sSQL, Len(sSQL) – 2) & “) “
    End If
    sSQL = sSQL & “VALUES (“
    ‘If the first field is an autonumber, make the value default
   If bAutoIncrement Then
        sSQL = sSQL & “DEFAULT, “
    End If
    ‘Loop through the record and add the values to the sql statement
   For Each rCell In rRecord.Cells
        If rCell.NumberFormat = “@” Then  ‘force a number to be text
           sSQL = sSQL & “‘” & CleanField(rCell.Value) & “‘, “
        ElseIf IsEmpty(rCell.Value) Or Not IsNumeric(rCell.Value) Then
            sSQL = sSQL & “‘” & CleanField(rCell.Value) & “‘, “
            sSQL = sSQL & rCell.Value & “, “
        End If
    Next rCell
    ‘get rid of the last comma-space sequence and close the paren
   sSQL = Left$(sSQL, Len(sSQL) – 2)
    sSQL = sSQL & “);”
    MakeInsertInto = sSQL
End Function
Function CleanField(sValue As String) As String
    Dim sTemp As String
    ‘double up quotes and underscores
   sTemp = Replace$(sValue, “‘”, “””)
    sTemp = Replace$(sTemp, “_”, “__”)
    CleanField = sTemp
End Function
Posted in Uncategorized

2 thoughts on “Create Mdb Tables in VBA

  1. Hi Dick,
    Maybe the reason you were experimenting with this topic was the same as…

    While spending way too much time on the code to deal with duplicates in multiple arrays, the one nagging thought I couldn’t escape was that the entire process was a major waste of time — other than being an interesting intellectual exercise.

    The easiest way to eliminate dups on a large scale would be to create a new table in a new db with just one field designated as ‘no duplicates’. Now, just add all the data in all the different arrays into this table, skip errors and you have the necessary solution. Very scalable in that it would work not only with in-memory arrays but also files!

    To put data back into the original sources, one would need a 2nd column in the table indicating the original source.

    It wouldn’t have the rebalance capability in the code I posted to the NG but it would be much more scalable — and easier to write. {grin}

  2. Hey Dick,

    I have been fiddling with something similar. Now I’m not as good at this stuff as the rest of you, but I think this might help. The whole making a SQL statement to do an INSERT INTO the Access table doesn’t seem to be the fastest/cleanest method. I recently changed how I getting the data from Excel into Access.

    I don’t know how to use ADO (yet) so I have DAO in my code but this is the short of it here. What I’ve done is CREATED the table which I know the field types I want and the total number of fields. Let me know what you think and if you need more info.

    Set rs = db.OpenRecordset(“tblDMLifeCycle”)

    ‘Insert data into the table
    intCount = 1
    ‘Load Array with values from Excel
    For i = 0 To 37
    varExcelInfo(i) = Application.Cells(intRcount, intCount)
    intCount = intCount + 1

    ‘Take values from Excel Array and plug into Access table.
    For i = 0 To 37
    rs.Fields(i) = varExcelInfo(i)

    ‘Move down Excel workbook.
    intRcount = intRcount + 1
    Erase varExcelInfo()
    Loop Until intRcount > End_Row

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.