Importing a list of CSV files using VBA (1 Viewer)

[r12wan]

Hi all

I regularly want to link a number of CSV files. Using VBA, I can import specified file names using

DoCmd.TransferText acLinkDelim, , "Baseline_001", "C:\Baseline_001.csv"
DoCmd.TransferText acLinkDelim, , "Baseline_002", "C:\Baseline_002.csv"
etc.

In order to extend this, I created an Excel table, called "ListOfTables" that contains names of all the CSV files under the single field "List". I planned to amend the above code using a loop to link one CSV file at a time, but have been unable.

Thanks in advance

r12wan

 

[Tanner65]

I'm assuming that each file will have a different import spec from what you've provided so far. So in order to do this you can do a few different things:
1) Move the information to a CSV file which makes it easier to read from using ADO and OLEDB.

2) Connect to the Excel spreadsheet using ADO and ADOX. You would simply interate through the Excel field "List" and change the import lines as necessary. Perhaps consider adding a bit more information to your table which could tell the application which import spec to use.

Code example 1:

Dim rsFile As ADODB.Recordset
dim sPath as String,sFilename as String
dim iRowCount as Integer
sPath = "Your path"

    sPath = sFileName
    '''To get the filename from the path
    Do Until InStr(1, sFileName, "\") = 0
        sFileName = Mid$(sFileName, InStr(1, sFileName, "\") + 1, Len(sFileName))
    Loop
    sPath = Replace(sPath, sFileName, "")
    
        Set rsFile = New ADODB.Recordset
        
        With rsFile
            .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath & ";Extended Properties=""Text;HDR=YES;FMT=(,)"""
            .CursorLocation = adUseClient
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .Open "Select * from [" & sFileName & "]"
            '''To debug what record we're on
            '''Should change to a do while loop
            '''Do while not rsFile.EndOfFile (EndOfSomething)
            For iRowCount = 1 to rsFile.RecordCount
                 [FONT=Courier New]DoCmd.TransferText acLinkDelim, , rsFile.Fields("ImportSpec").value, rsFile.fields("List").value[/FONT]
                 rsFile.MoveNext
            Next
            .Close
        End With
        Set rsFile = Nothing

Code example 2:

    Dim cnXLS As ADODB.Connection
    Dim catXLS As ADOX.Catalog
    Dim rsFile As ADODB.Recordset

dim sPath as String,sFilename as String
dim iRowCount as Integer
sPath = "Your path"

    sPath = sFileName
    '''To get the filename from the path
    Do Until InStr(1, sFileName, "\") = 0
        sFileName = Mid$(sFileName, InStr(1, sFileName, "\") + 1, Len(sFileName))
    Loop
    sPath = Replace(sPath, sFileName, "")

        Set cnXLS = New ADODB.Connection
        Set catXLS = New ADOX.Catalog
        Set rsFile = New ADODB.Recordset
        With cnXLS
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Properties("Extended Properties").Value = "Excel 8.0;HDR=YES;IMEX=1"
            .Open sPath & sFileName
        End With
    
        catXLS.ActiveConnection = cnXLS
        With rsFile
            .ActiveConnection = cnXLS
            .CursorLocation = adUseClient
            .LockType = adLockOptimistic
            .CursorType = adOpenKeyset
            .Open "Select * from [" & catXLS.Tables("YourTabName").Name & "]"
            '''To debug what record we're on
            '''Should change to a do while loop
            '''Do while not rsFile.EndOfFile (EndOfSomething)
            For iRowCount = 1 to rsFile.RecordCount
                 [FONT=Courier New]DoCmd.TransferText acLinkDelim, , rsFile.Fields("ImportSpec").value, rsFile.fields("List").value[/FONT]
                 rsFile.MoveNext
            Next
  
            .Close
            Set .ActiveConnection = Nothing
        End With
if cnXLS.state <> 0 then cnXLS.close
if catXLS.state <> 0 then catXLS.close
set cnXLS = nothing
set catXLS = nothing
set rsFile = nothing

Hope that helps ya!

Please note: I'm writing this after not using VBA/VB6 for over 4 months, so it may not work perfectly the first time.