Create Access database on the fly & import csv/txt file as table!
Hi Everybody
I have a need to create an Access database on the fly from within Excel VBA. I have been able to do this - no problem. What I now need is to be able to import a table directly in to this database from a csv or txt file. Does anyone know how to do this with the first row containing row headings rather than create a new table, define each field and populate each row by first reading and splitting each row of data from the csv or txt file and splitting it by the delimiter and writing it in to the recordset and then batch updating the recordset? The reason is that the input dataset is a very large - between 2 and 7 million records and 10 fields.
I have previously done this using the method detailed above - the only difference being that the data was read from a spreadsheet cell by cell, which in this case, is not feasible, given the number of records in the input table.
This is kind of desperate situation. An early response from you all shall be hgihly valued. Thanks a zillion in advance.
Best regards
Deepak Agarwal
The code that I had working for this methodology is shown below for your immediate reference :-
Code:
' Please ignore variable declaration since this is a partial copy and paste from the original full code
Sub CreateDatabaseAndTables()
Dim Catalog As Object
Dim cnt As ADODB.Connection
Dim dbConnectStr As String, dbName As String
' Creating database here!
dbName = "D:\SourceDataDB.mdb"
dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";"
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create dbConnectStr
Set Catalog = Nothing
Dim fd As FileDialog
Dim adoxTable As ADOX.Table
Dim spreadsheetRange As Range
Dim adoCN As ADODB.Connection
Dim adoxCatalog As ADOX.Catalog
Dim rs As ADODB.Recordset, rsData As Recordset
Dim tableName As String, sourceBookSheetName As String, msg1 As String
Dim myArray() As Variant
Set adoCN = New Connection
With adoCN
.Provider = "Microsoft.Jet.OLEDB.4.0": .ConnectionString = dbName: .Open
End With
Set adoxCatalog = New ADOX.Catalog
Set adoxCatalog.ActiveConnection = adoCN
Set adoxTable = New ADOX.Table
wrkg = start: finish1 = 3
tableName = "SummaryCombinations"
' Creating table here!
With adoxTable
.Name = tableName
Do While wrkg < finish1
.Columns.Append "Item" & (wrkg + 1)
wrkg = wrkg + 1
Loop
End With
adoxCatalog.Tables.Append adoxTable
Set rs = New ADODB.Recordset
rsSQL = "Select * from " & tableName
rs.Open rsSQL, adoCN, adOpenKeyset, adLockOptimistic
sourceBookSheetName = tableName
Workbooks.Open selectedFilePathAndName
' Populating table here by reading the worksheet data cell by cell rather than using ADO to read worksheet dataWorksheets(combinationSheetName).Activate
startRow = 2: fieldCountStart = 0: recordCountStart = 0
finalRow = Cells(startRow, startCol).End(xlDown).Row
wrkgRow = startRow: wrkgCol = startCol
recordCountWrkg = recordCountStart
Do While wrkgRow <= finalRow
rs.AddNew
fieldCountWrkg = fieldCountStart
Do While wrkgCol <= finish1
rs.Fields(fieldCountWrkg) = Cells(wrkgRow, wrkgCol).Value
wrkgCol = wrkgCol + 1
fieldCountWrkg = fieldCountWrkg + 1
Loop
wrkgCol = startCol
wrkgRow = wrkgRow + 1
recordCountWrkg = recordCountWrkg + 1
Loop
rs.UpdateBatch
rs.Close
Set rs = Nothing
Workbooks(ActiveWorkbook.Name).Close
adoCN.Close
Set adoCN = Nothing
End Sub
Create table on the fly in ms access
Code:
Sub createTblOnTheFly()
Dim strSQL As String
strSQL = " CREATE TABLE TimeRecord (IDNo Text(30), DTR_Date datetime, TIME_IN datetime, TIME_OUT datetime, LB_IN datetime, LB_OUT datetime, CB_IN datetime, CB_OUT datetime)"
Dim myConnection As ADODB.Connection
Set myConnection = New ADODB.Connection
myConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & "C:\Users\efgarcia\Documents\database2.accdb;Persist Security Info=False;"
myConnection.Open
Dim NewTableName As String
' NewTableName = InputBox("What name do you want to give the table?")
' Check presence of table
Dim rsSchema As ADODB.Recordset
Set rsSchema = New ADODB.Recordset
Set rsSchema = myConnection.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, "TimeRecord", Empty))
If rsSchema.BOF And rsSchema.EOF Then
MsgBox "Table does not exist"
myConnection.Execute strSQL, dbFailOnError
Else
MsgBox "Table exists"
End If
rsSchema.Close
Set rsSchema = Nothing
' DBEngine(0)(0).Execute strSQL, dbFailOnError
' DoCmd.RunSQL strSQL
End Sub
