Link to home
Start Free TrialLog in
Avatar of Euro5
Euro5Flag for United States of America

asked on

Pull multiple cvs files into one access table

I need a code to pull hundreds of cvs files into one access table.
The files are identical in structure -  just need to combine in a batch from desktop rather than one at a time.
Could I use VBA?


Can anyone help?
Avatar of Mlungisi Ndlela
Mlungisi Ndlela
Flag of South Africa image

I think M-Access has a limitation so if you will have a lot of files and if they exceed I think 5GB then you will have a problem. But I think a
For Each

Open in new window

loop may help you. Show us what you have done so far.
Avatar of Euro5

ASKER

Here is what I have...
but I am getting error on

Customer_Data ERROR Variable not defined.

Option Compare Database

Option Explicit

Function DoImport()

 Dim strPathFile As String
 Dim strFile As String
 Dim strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in CSV worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the CSV files
 strPath = "C:\Documents\Lorrie"

 ' Replace tablename with the real name of the table into which
 ' the data are to be imported

 strFile = Dir(strPath & "*.csv")


 Do While Len(strFile) > 0
       strTable = Customer_Data
       strPathFile = strPath & strFile
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames


 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

       strFile = Dir()

 Loop


End Function

Open in new window

Avatar of Euro5

ASKER

This runs, but does not import my files!!

Option Compare Database

Option Explicit

Function DoImport()

 Dim strPathFile As String
 Dim strFile As String
 Dim strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in CSV worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the CSV files
 strPath = "C:\Users\542323\Documents\Lorrie"

 ' Replace tablename with the real name of the table into which
 ' the data are to be imported

 strFile = Dir(strPath & "*.csv")


 Do While Len(strFile) > 0
       strTable = "Customer_Data"
       strPathFile = strPath & strFile
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames


 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

    '   strFile = Dir()

 Loop


End Function

Open in new window

Avatar of Euro5

ASKER

I am trying this code, but error on
You have entered an invalid reference to FileSearch


Private Sub Test2()

'Enable the following references in the
'  VBA screen under menu option Tools > References:
'      Microsoft Office x.0 Object Library
'            (where x is your version number, e.g. 10, 11, 12 etc)

'Note : This process assumes there is an import table already created
'  with 3 fields called F1, F2 and F3 of the following types:
'  F1 = Date, F2 = Number (not integer), F3 = Text

'Change the line below to the actual name of your
'  import table in your database
Const MyImportTable As String = "Customer_Data"
'Change the line below to the name of the
'  directory that contains the import files
Const MyImportFileDir As String = "C:\User\Lorrie"

Dim Counter As Integer, tmpName As String

On Error GoTo ErrorHandler

DoCmd.SetWarnings (False)
DoCmd.Hourglass (True)
'Remove the line below if you don't want to clear the import table
' when you run this process
'DoCmd.RunSQL "DELETE " & MyImportTable & ".* FROM " & MyImportTable & ";"

With Application.FileSearch
    .NewSearch
    .LookIn = MyImportFileDir
    .SearchSubFolders = False 'set to True if you want to search subfolders too
    .FileType = msoFileTypeAllFiles 'get all files in the directory
    If .Execute() > 0 Then 'files found
        For Counter = 1 To .FoundFiles.Count 'loop through files
            .FileName = .FoundFiles(Counter) 'set / get the file name
            DoCmd.TransferText , , MyImportTable, .FileName, False 'import file
            tmpName = Mid$(.FileName, Len(.LookIn) + 2)
            tmpName = Left$(tmpName, Len(tmpName) - 4)
            'add the source file name to the import table
            DoCmd.RunSQL "UPDATE " & MyImportTable & _
                    " SET " & MyImportTable & ".F3 = '" & tmpName & _
                    "' WHERE ((" & MyImportTable & ".F3) Is Null);"
        Next Counter
        'Remove the blank records created during the import
        '  due to the file headers (these may appear as import errors)
        DoCmd.RunSQL "DELETE " & MyImportTable & _
                    ".* FROM " & MyImportTable & _
                    " WHERE ((" & MyImportTable & ".F1) Is Null);"
        MsgBox "Import complete.", vbInformation, "Done"
    Else 'files not found
        MsgBox "There were no files found.", vbCritical, "Error"
    End If
End With

DoCmd.Hourglass (False)
DoCmd.SetWarnings (True)

ExitHere:
    Exit Sub

ErrorHandler:
    DoCmd.Hourglass (False)
    DoCmd.SetWarnings (True)
    MsgBox Err.Description, vbCritical, "Error# " & Err.Number
    GoTo ExitHere

End Sub

Open in new window

Please explain
Customer_Data

Open in new window

for me, is it suppose to be a variable or its an identifier?
Avatar of Euro5

ASKER

That is supposed the be the identifier - the table name
Avatar of Euro5

ASKER

This code seems accurate and runs, but does not actually update the table.
Function DoImport()

 Dim strPathFile As String
 Dim strFile As String
 Dim strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in CSV worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the CSV files
 strPath = "C:\Users\542323\Documents\Lorrie"

 ' Replace tablename with the real name of the table into which
 ' the data are to be imported

 strFile = Dir(strPath & "*.csv")


 Do While Len(strFile) > 0
       strTable = "Customer_Data"
       strPathFile = strPath & strFile
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames


 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

      strFile = Dir()

 Loop


End Function

Open in new window

Avatar of Euro5

ASKER

Changed to
Option Explicit
with code above
Avatar of Euro5

ASKER

This runs until  Do While Len(strFile) > 0
Where it stops - but no error

Option Explicit

Public Sub DoImport()

 Dim strPathFile As String
 Dim strFile As String
 Dim strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in CSV worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the CSV files
 strPath = "C:\Users\542323\Documents\Lorrie"

 ' Replace tablename with the real name of the table into which
 ' the data are to be imported

 strFile = Dir(strPath & "*.csv")


 Do While Len(strFile) > 0
       strTable = "Customer_Data"
       strPathFile = strPath & strFile
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames


 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

      strFile = Dir()

 Loop


End Sub
You need to change that and use something like this
For Each xFile In strFile

Open in new window

this should solve your problem
regarding the loop through each file.
Avatar of Euro5

ASKER

I have no idea what to do with this.
Avatar of PatHartman
Here is working code from one of my applications.  It takes all the files in the specified folder and imports them.  It is a two step process because the .xlsx files are reports rather than tables so they get imported into a temp table first and then appended to the checks table.

It requires a reference to the Microsoft Scripting runtime.

Private Sub cmdImport_Click()
    Dim db                  As DAO.Database
    Dim td                  As DAO.TableDef
    Dim rs                  As DAO.Recordset
    Dim strProcessed        As String
    Dim fs                  As Scripting.FileSystemObject
    Dim folder As Scripting.folder
    Dim file As Scripting.file
    Dim filefolder
    Dim ToFolderName        As String
    Dim CountBankInput      As Long
    Dim CountChecksBefore   As Long
    Dim CountChecksAfter    As Long
    Dim FileCounter         As Long
    Dim FileName            As String
    Dim LastImport          As Variant
    
    On Error GoTo Err_Proc

    If Me.txtFolder & "" = "" Then
        MsgBox "Please select a folder to import.", vbOKOnly
        Exit Sub
    End If
    
    Set db = CurrentDb()
    Set td = db.TableDefs!tblImportLog
    Set rs = td.OpenRecordset
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set folder = fs.GetFolder(Me.txtFolder)
    Set filefolder = folder.Files
    
    FileCounter = 0
    For Each file In filefolder
        If file.Type = "Microsoft Excel Worksheet" Then
            FileCounter = FileCounter + 1
            FileName = folder.Path
            If Right(FileName, 1) = "\" Then
                FileName = FileName & file.Name
            Else
                FileName = FileName & "\" & file.Name
            End If
            LastImport = DMax("SourceFileName", "tblImportLog")
            If file.Name > LastImport Or IsNull(LastImport) Then
            Else
                If file.Name = DLookup("SourceFileName", "tblImportLog", "SourceFileName = '" & file.Name & "'") Then
                    MsgBox "This file has already been imported.  Please remove it from the import folder and start again.", vbOKOnly
                    Exit Sub
                Else
                    MsgBox "This file name is from a prior period.  Please have the programmer validate the data before continuing.", vbOKOnly
                    Exit Sub
                End If
            End If
            Me.txtFile = FileName
            Me.Repaint
            rs.AddNew
                rs!sourcefilename = Mid(Me.txtFile, InStrRev(Me.txtFile, "\") + 1)
                rs!sourcepathname = Left(Me.txtFile, InStrRev(Me.txtFile, "\"))
                rs!ImportDT = Date
                Me.txtBatchID = rs!BatchID            'will not work with SQL Server

            GoSub FileProcess
                rs!RecCount = DCount("*", "tblBankInput", "SourceFileName = '" & file.Name & "'")
            
            rs.Update
        End If
    Next
    Me.Repaint
    
FileProcess:
    strProcessed = Replace(Me.txtFile, "\Output\", "\Processed\")
    ToFolderName = Left(strProcessed, InStrRev(strProcessed, "\"))
    
    DoCmd.RunMacro "mWarningsOff"
    CountBankInput = 0
    CountChecksBefore = 0
    CountChecksAfter = 0
'empty work tables
    DoCmd.OpenQuery "qDelSheet1"
'import spreadsheet
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Sheet1", Me.txtFile, False
'append to work table
    DoCmd.OpenQuery "qAppFirstColumns"
    DoCmd.OpenQuery "qAppSecondColumns"
    CountBankInput = DCount("*", "tblBankInput")
    CountChecksBefore = DCount("*", "tblChecks")
'append new items to final table
    DoCmd.OpenQuery "qAppChecks"
    CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
    DoCmd.OpenQuery "qUpdChecks_CD1"
    DoCmd.OpenQuery "qUpdChecks_CD2"
    DoCmd.OpenQuery "qUpdChecks_CD3"
    DoCmd.OpenQuery "qUpdChecks_CD4"
    DoCmd.OpenQuery "qUpdChecks_CD5"
    DoCmd.OpenQuery "qUpdChecks_CDNone"

        fs.CopyFile Source:=Me.txtFile, Destination:=ToFolderName
        Kill Me.txtFile

    Return
    
Exit_Proc:
    DoCmd.RunMacro "mWarningsOn"
    MsgBox "Complete " & FileCounter & " files imported.", vbOKOnly
    Exit Sub
Err_Proc:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume Exit_Proc
            Resume
    End Select
End Sub

Open in new window

Your problem is within your directory/file looping. Do this
Dim strPath As DirectoryInfo = _
 New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")

Dim fi As FileInfo() = strPath.GetFiles("*.csv")
Dim fri As FileInfo
' Now loop through each file
For Each fri In fi
' Now you can do what you want to do here, this will be done on each matching file.
strTable = "Customer_Data"
       strPathFile = fri.FullName
Try
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
Catch ex As Exception
MsgBox(ex.Message) ' This will return an error message if there is any error occurs.
End Try

Open in new window


First try this out and see. Also I couldn't test your
DoCmd.TransferText....

Open in new window

but the above code should help you loop through each file, you will need to ensure that your code that I've just stated that I haven't tested you need to make sure it execute, also you need to use Try to catch exceptions
Avatar of Euro5

ASKER

I get error msgs -
Dim strPath As DirectoryInfo = _
 New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")

and

Dim fi As FileInfo() = strPath.GetFiles("*.csv")

many errors throughout - is this for Access?
What is the error message you are getting? Also the above will require you to import the
System.IO

Open in new window

post the error message so I can take a look at it, also where does it occurs?

I suggest to test the above, create a test project and test on it and do adjustments you need on it then you will have the full working solution which you can then take it to your project.
Avatar of Euro5

ASKER

mlungisi ndlela
User generated image
How do I import the System IO?

Thanks so much for your help!
I feel very lost on this.
testLorrie.JPG
Avatar of Euro5

ASKER

I tried to include it above

Import System.IO


Sub ImportData()


Dim strPath As DirectoryInfo = _
 New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")

Dim fi As FileInfo() = strPath.GetFiles("*.csv")
Dim fri As FileInfo
' Now loop through each file
For Each fri In fi
' Now you can do what you want to do here, this will be done on each matching file.
strTable = "Customer_Data"
       strPathFile = fri.FullName
Try
       DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
Catch ex As Exception
MsgBox (ex.Message) ' This will return an error message if there is any error occurs.
End Try
End Sub

Open in new window

Avatar of Euro5

ASKER

I am trying following but error
User generated image
You are not using VB.NET, I think you are using VB6 or VB5 not sure, which Visual Basic are you using because that error message box I mostly see it on VB5.0?
Secondly on this code
Dim strPath As DirectoryInfo = _
 New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")

Open in new window

change it to
Dim strPath As DirectoryInfo = New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")

Open in new window

and also this code is a VB.NET code which I doubt it will function proper on VB6/5.0/3...., Tell me what version of VB you are using, I also have VB5.0 here so I can try helping you out. Also what you should know with older versions is that they use
Dir()

Open in new window

function for directory which is also supported by VB.NET.

You can't downgrade but you can upgrade, in order to downgrade you will need to change the code to a code understood by your IDE.
Avatar of Euro5

ASKER

I am using Access 2013.
Did you take a look at the procedure I posted?  It is Access VBA and it works.  You just have to customize it.
Avatar of Euro5

ASKER

PatHartman

I did, but I couldn't figure out how to customize.
I am not sure how a lot of the code compares to mine.
Would love to have it work!

'append new items to final table
    DoCmd.OpenQuery "qAppChecks"
    CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
    DoCmd.OpenQuery "qUpdChecks_CD1"
    DoCmd.OpenQuery "qUpdChecks_CD2"
    DoCmd.OpenQuery "qUpdChecks_CD3"
    DoCmd.OpenQuery "qUpdChecks_CD4"
    DoCmd.OpenQuery "qUpdChecks_CD5"
    DoCmd.OpenQuery "qUpdChecks_CDNone"

Open in new window

You can ignore the update queries since they update the data after it is imported.

The app imports the initial spreadsheet into a temp table.  The spreadsheet is a "report" and has two "columns" of data.  The columns snake.  So the left set of columns is records 1-30 and the second set of columns is records 31-60.  So there is a lot of extra work that is happening.  You haven't really told us what work you are doing beyond importing.  You just want to get to the import.

You were obviously having trouble working with air code so I did not want to take a chance on deleting something important so I just left the procedure intact.
The following is not really relevant to your task:
'append to work table
    DoCmd.OpenQuery "qAppFirstColumns"
    DoCmd.OpenQuery "qAppSecondColumns"
    CountBankInput = DCount("*", "tblBankInput")
    CountChecksBefore = DCount("*", "tblChecks")
'append new items to final table
    DoCmd.OpenQuery "qAppChecks"
    CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
    DoCmd.OpenQuery "qUpdChecks_CD1"
    DoCmd.OpenQuery "qUpdChecks_CD2"
    DoCmd.OpenQuery "qUpdChecks_CD3"
    DoCmd.OpenQuery "qUpdChecks_CD4"
    DoCmd.OpenQuery "qUpdChecks_CD5"
    DoCmd.OpenQuery "qUpdChecks_CDNone"

Once you get beyond the TransferSpreadsheet, you are into whatever you want to do with the data after you import/link the spreadsheet.  Notice that I am reusing the same working table for each file so qDelSheet1 removes the rows before importing the new data.  You can use acLink instead of acImport.  I chose to import because I wanted more control over the process since the data was frequently bad and the append and update queries cleaned it up.

The two macros - mWarningsOff and mWarningsOn are the ONLY macros I ever use.  I use a macro to control the warnings because when I turn warnings off, I want to turn the hourglass on and vice versa.  The macro is a convenient way to do that without having to remember to always write the two lines of code.  It is EXTREMELY important that you never leave warning off.  Leaving them off while in development mode could cause you to lose hours of work if you forget to specifically save before you close an object you have been modifying.  Access will silently discard any unsaved changes because you said to turn warnings off.  You only have to be burned once to never forget the experience.
Avatar of Euro5

ASKER

Right, I just need to get the sheets into one Access table.
The problem is I have hundreds of these .csv files, so I can't possibly do them one at a time.


So this is what I am working with?
I get an error "Invalid use of ME keyword"

Private Sub cmdImport_Click()
    Dim db                  As DAO.Database
    Dim td                  As DAO.TableDef
    Dim rs                  As DAO.Recordset
    Dim strProcessed        As String
    Dim fs                  As Scripting.FileSystemObject
    Dim folder As Scripting.folder
    Dim file As Scripting.file
    Dim filefolder
    Dim ToFolderName        As String
    Dim CountBankInput      As Long
    Dim CountChecksBefore   As Long
    Dim CountChecksAfter    As Long
    Dim FileCounter         As Long
    Dim FileName            As String
    Dim LastImport          As Variant
   
    On Error GoTo Err_Proc

    If Me.txtFolder & "" = "" Then
        MsgBox "Please select a folder to import.", vbOKOnly
        Exit Sub
    End If
   
    Set db = CurrentDb()
    Set td = db.TableDefs!tblImportLog
    Set rs = td.OpenRecordset
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set folder = fs.GetFolder(Me.txtFolder)
    Set filefolder = folder.Files
   
    FileCounter = 0
    For Each file In filefolder
        If file.Type = "Microsoft Excel Worksheet" Then
            FileCounter = FileCounter + 1
            FileName = folder.Path
            If Right(FileName, 1) = "\" Then
                FileName = FileName & file.Name
            Else
                FileName = FileName & "\" & file.Name
            End If
            LastImport = DMax("SourceFileName", "tblImportLog")
            If file.Name > LastImport Or IsNull(LastImport) Then
            Else
                If file.Name = DLookup("SourceFileName", "tblImportLog", "SourceFileName = '" & file.Name & "'") Then
                    MsgBox "This file has already been imported.  Please remove it from the import folder and start again.", vbOKOnly
                    Exit Sub
                Else
                    MsgBox "This file name is from a prior period.  Please have the programmer validate the data before continuing.", vbOKOnly
                    Exit Sub
                End If
            End If
            Me.txtFile = FileName
            Me.Repaint
            rs.AddNew
                rs!sourceFileName = Mid(Me.txtFile, InStrRev(Me.txtFile, "\") + 1)
                rs!sourcepathname = Left(Me.txtFile, InStrRev(Me.txtFile, "\"))
                rs!ImportDT = Date
                Me.txtBatchID = rs!BatchID            'will not work with SQL Server

            GoSub FileProcess
                rs!RecCount = DCount("*", "tblBankInput", "SourceFileName = '" & file.Name & "'")
           
            rs.Update
        End If
    Next
    Me.Repaint
   
FileProcess:
    strProcessed = Replace(Me.txtFile, "\Output\", "\Processed\")
    ToFolderName = Left(strProcessed, InStrRev(strProcessed, "\"))
   
    DoCmd.RunMacro "mWarningsOff"
    CountBankInput = 0
    CountChecksBefore = 0
    CountChecksAfter = 0
'empty work tables
    DoCmd.OpenQuery "qDelSheet1"
'import spreadsheet
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Sheet1", Me.txtFile, False

    Return
   
Exit_Proc:
    DoCmd.RunMacro "mWarningsOn"
    MsgBox "Complete " & FileCounter & " files imported.", vbOKOnly
    Exit Sub
Err_Proc:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume Exit_Proc
            Resume
    End Select
End Sub
ASKER CERTIFIED SOLUTION
Avatar of PatHartman
PatHartman
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Euro5

ASKER

PatHartman - Got it. I didn't create a button , so I will do that.