VBA Access: Import CSV with additonal header data - vba

Question

I am new to coding VBA. Was wondering if you all could help me? I have a CSV file which is structured as the following:
- First 22 rows cover the specfic header data(this all loads in one column in excel)
- column headers for table are in Row 23
- the data is actually located from row 24 onward.
What the code needs to do is insert this data in new table with the right column titles. Also while inserting it needs to input the file name and header data in the first few columns of the table.
So far I have imported the entire CSV into an array I believe:
See what I have so far:
Sub readCSV()
Dim fs As Object
Dim fso As New FileSystemObject
Dim tsIn As Object
Dim sFileIn, filename As String
Dim aryFile, aryHeader, aryBody As Variant
sFileIn = "C:\doc\test.csv"
Set filename = fso.GetFileName(sFileIn)
Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)
sTmp = tsIn.ReadAll
aryFile = Split(sTmp, vbCrLf)
For i = 1 To 22
aryHeader(1, i) = aryFile(i)
Next i
For i = 23 To UBound(aryFile)
aryBody(i) = Split(aryFile(i), ",")
DoCmd.RunSQL "INSERT INTO MAINS VALUES (filename,aryHeader(1),aryBody(i))"
Next i
End Sub
is this correct? Can anyone see of i am taking the right approach
UPDATE - recoded this a bit

Answer 1

Use DoCmd.TransferText instead of rolling out your own code:
http://msdn.microsoft.com/en-us/library/office/ff835958%28v=office.15%29.aspx
In your Import Specification, you can set the starting row.
See Skip first three lines of CSV file (using DoCmd?) in MS Access for more information!
Edit: The import specification can be changed to rename the fields etc. See http://www.access-programmers.com/creating-an-import-specification-in-access-2003.aspx (the Import wizard exists in Access 2007 as well) and the Advanced dialog specifically.

Answer 2

I was a bit irked by the use of multiple arrays in your code (which is super confusing, to me, anyway, because you are looking at counters everywhere) so I thought I would post an alternative for you. If you can do it your way, more power to you, but if you run into problems, you can try this. Code below is much more verbose, but may save you time in the future if you hand it off or even have to come back to it yourself and have no idea what is going on (lol):
Sub ReadCSV()
On Error GoTo ErrorHandler
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim fso As Scripting.FileSystemObject
Dim tst As Scripting.TextStream
Dim strFileName As String
Dim intCurrentLine As Integer
Dim strCurrentLine As String
Dim intHeaderRows As Integer
Dim strHeader As String
Dim strHeaderDelimInField As String
'Consider these your 'constants', so you don't come back to this code in a month
'and wonder what the random numbers mean.
intHeaderRows = 22 'Number of header rows in CSV.
strHeaderDelimInField = "~" 'The character(s) you want to separate each
'header line, in field.
strFileName = "C:\IrregularCSV.csv"
intCurrentLine = 1 'Keep track of which line in the file we are currently on.
'Next two lines get a reference to your table; will add data via DAO and not SQL,
'to avoid messy dynamic SQL.
Set db = CurrentDb()
Set rst = db.OpenRecordset("Mains", dbOpenDynaset)
Set fso = New Scripting.FileSystemObject
Set tst = fso.OpenTextFile(strFileName, ForReading)
'Instead of storing data in arrays, let's go through the file line by line
'and do the work we need to do.
With tst
Do Until .AtEndOfStream
strCurrentLine = .ReadLine
If intCurrentLine <= intHeaderRows Then
strHeader = strHeader & strHeaderDelimInField & strCurrentLine
Else
'Add the records via DAO here.
rst.AddNew
'In DAO, rst.Fields("FieldName") are the columns in your table.
rst.Fields("FileName") = strFileName
'Remove leading delimiter with Right.
rst.Fields("HeaderInfo") = Right(strHeader, Len(strHeader) - 1)
'Note that Split always returns a zero-based array
'and is unaffected by the Option Base statement.
'The way below is less efficient than storing
'the return of Split, but also less confusing, imo.
rst.Fields("Field1") = Split(strCurrentLine, ",")(0)
rst.Fields("Field2") = Split(strCurrentLine, ",")(1)
rst.Fields("Field3") = Split(strCurrentLine, ",")(2)
rst.Update
End If
intCurrentLine = intCurrentLine + 1
Loop
End With
tst.Close
rst.Close
ExitMe:
Set tst = Nothing
Set fso = Nothing
Set rst = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ": " & Err.Description
GoTo ExitMe
End Sub
To be honest, I think there are a lot of gotchas to the way you are going about it. Not saying it won't work, because I think it can, but this method is more robust. An unexpected single quote won't ruin your work and using a data object to do the inserts is not prone (well, less, at least) to SQL injection issues. And I've done it with no persisted arrays. Anyway, some food for thought. Good luck.

Answer 3

this is what i ended up:
Sub ReadCSV2()
Dim fs As Object
Dim filename As String
Dim tsIn As Object
Dim sFileIn As String
Dim aryHeader, aryBody As Variant
Dim Text As String
Dim sqlcre As String
Dim sqlsta As String
sFileIn = "C:\test\test.csv"
filename = GetFilenameFromPath(sFileIn) 'function to get the file name
Set fs = CreateObject("Scripting.FileSystemObject")
Set tsIn = fs.OpenTextFile(sFileIn, 1)
For i = 1 To 23
Tmps = tsIn.ReadLine
Next i
aryHeader = Split(Tmps, ",")
On Error Resume Next
DoCmd.RunSQL "DROP TABLE tempdata"
On Error GoTo 0
sqlcre = "CREATE TABLE tempdata ([Filename] Text,"
For k = LBound(aryHeader) To UBound(aryHeader)
sqlcre = sqlcre & "[" & aryHeader(k) & " " & k + 1 & "] Text,"
Next k
k = k - 1
sqlcre = Left(sqlcre, Len(sqlcre) - 13) & ")"
'Debug.Print k
'Debug.Print sqlcre
DoCmd.RunSQL sqlcre
DoCmd.SetWarnings False
While Not tsIn.AtEndOfStream
Tmps = tsIn.ReadLine
aryBody = Split(Tmps, ",")
sqlsta = "INSERT INTO tempdata VALUES ('" & filename & "','"
For M = LBound(aryBody) To UBound(aryBody)
sqlsta = sqlsta & Replace(aryBody(M), "'", "`") & "', '"
Next M
M = M - 1
Debug.Print M
If M < k Then
Text = ""
For i = 1 To (k - M)
Text = Text & "', '"
Next i
sqlsta = sqlsta & Text
End If
sqlsta = Left(sqlsta, Len(sqlsta) - 7) & ")"
'Debug.Print sqlsta
'Debug.Print k
DoCmd.RunSQL sqlsta
Wend
DoCmd.SetWarnings True
End Sub