Option Explicit
 
Const stPath As String = “c:DDE”
Const stDBase As String = “Source.mdb”
 
‘In order to create a mdb in Access 97 format add the line to the connection string:
‘”Jet OLEDB:Engine Type=4;”
‘The default is Access 2000 format (Type=5).
Const stCon As String = _
“Provider=Microsoft.Jet.OLEDB.4.0;” & _
“Data Source=” & stPath & stDBase & “;”
 
‘The SQL-query to import data from the textfile.
Const stSQLAdd As String =  _
“INSERT INTO tblReportData “ & _
“SELECT * “ & _
“FROM [Text;DATABASE=” & stPath & “].[Data.txt];”
 
‘The SQL-query to import selected summarized data from the mdb-file.
Const stSQLSelect As String = _
“SELECT Dept, Quarter, SUM(Amount) “ & _
“FROM tblReportData “ & _
“GROUP BY Dept, Quarter;”
 
Sub Create_MDB_On_The_Fly()
Dim xCat As ADOX.Catalog, xTable As ADOX.Table, xCol As ADOX.Column
Dim cnt As ADODB.Connection, rst As ADODB.Recordset
Dim wsSheet As Worksheet
 
‘Delete the present mdb.
On Error Resume Next
Kill stPath & stDBase
On Error GoTo 0
 
‘Instantiate the objects.
Set wsSheet = ActiveSheet
Set xCat = New ADOX.Catalog
Set xTable = New ADOX.Table
 
‘Create the new mdb.
xCat.Create stCon
 
‘Add columns to the table and make sure that they accept null values.
With xTable
    ‘Name the table.
   .Name = “tblReportData”
    .Columns.Append “Dept”
    .Columns.Append “Quarter”
    .Columns.Append “Amount”, adInteger
    ‘Provide access to provider specific properties.
   .ParentCatalog = xCat
    For Each xCol In .Columns
        .Columns(xCol.Name).Properties(“Nullable”).Value = True
    Next xCol
End With
   
‘Add the table to the mdb.
xCat.Tables.Append xTable
 
‘You will be surprised when You see the outcome of the following.
Debug.Print xCat.ActiveConnection
 
‘Associate the variable to the already open connection.
Set cnt = xCat.ActiveConnection
 
With cnt
    ‘Import the data from the text file.
   .Execute (stSQLAdd)
    ‘Retrieve a recordset from the mdb.
   Set rst = .Execute(stSQLSelect)
End With
 
If Not rst.BOF Or rst.EOF Then
    Application.ScreenUpdating = False
    ‘Add fieldnames and dump the retrieved recordset into the active sheet.
   With wsSheet
        With .Range(“A1:C1”)
            .Value = VBA.Array(“Dept”, “Quarter”, “Total amount”)
            .Font.Bold = True
            .EntireColumn.AutoFit
        End With
        .Range(“A2”).CopyFromRecordset rst
    End With
    Application.ScreenUpdating = True
End If
 
Set rst = Nothing: Set cnt = Nothing
Set xCol = Nothing: Set xTable = Nothing: Set xCat = Nothing
End Sub