Importing multiple text files into one table

[acarriere]

Hello, I'm very new to Access and writing code (this is day one). I am trying to import multiple text files from one folder into a table and add a new column that identifies the file name.

I've tried to adapt the following code to my needs, but Access 2010 apparently does not like FileSearch. I apologize if my question is too simple for this forum.

Function ImportCSVFiles() Dim FilesToProcess As Integer Dim i As Integer Dim bArchiveFiles As Boolean Dim sFileName As String Dim sOutFile As String Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit Const DEST_TABLE = "tblUsers" 'change to suit Const IMPORT_SPEC = "CSV_Import_Spec" 'change to suit Const PATH_DELIM = "\" 'set to False if you DON'T want to move imported files to new folder bArchiveFiles = True 'the FileSearch object lets you search a folder and, optionally its subfolders, 'for files of a defined type. It loads the names of all found files into an array, 'which we can use to import those files. With Application.FileSearch .NewSearch .LookIn = TOP_FOLDER .SearchSubFolders = False 'we only want to search the top folder .FileName = "*.csv" 'change this to suit your needs .Execute FilesToProcess = .FoundFiles.Count 'check that files have been located. If not, display message and exit routine. If FilesToProcess = 0 Then MsgBox "No files found, nothing processed", vbExclamation Exit Function End If For i = 1 To FilesToProcess 'import each file DoCmd.TransferText acImportDelim, IMPORT_SPEC, DEST_TABLE, _ .FoundFiles(i), True 'archive the imported files If bArchiveFiles Then 'code for archiving imported files... sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4)) sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1) sFileName = StrRev(sFileName) sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _ & Format(Date, "yyyymmdd") & ".csv" FileCopy .FoundFiles(i), sOutFile Kill .FoundFiles(i) End If Next i End With End Function 'The StrRev function reverses a text string. We are using it here to simplify 'extracting the file name: once the full path is reversed, we can pull out everything 'to the left of the first path delimiter. Reversing this string gives us the file name. 'Note: VBA has a StrReverse function that you can use instead of this custom function. Function StrRev(sData As String) As String Dim i As Integer Dim sOut As String sOut = "" For i = 1 To Len(sData) sOut = Mid(sData, i, 1) & sOut Next i StrRev = sOut End FunctionThanks

 

[Pat Hartman]

Welcome aboard My eyes crossed when I tried to read your code. Please format it properly and use the code tags to surround it when posting so that the formatting is retained.

 

[John Big Booty]

Just as a follow on from Pat's comments the Code Tag is the Hash Mark button at the top of the posting window

 

[John Big Booty]

I'm sure if you can repost using the Code tag you will get an answer in sort order, but as it stand that code looks as if it's been Greeked

 

[acarriere]

Thanks for the tips! Here is what I hope is a better formatted version (it seems to change to the big block of text if I press preview):

Function ImportCSVFiles()    Dim FilesToProcess As Integer    Dim i As Integer    Dim bArchiveFiles As Boolean    Dim sFileName As String    Dim sOutFile As String    Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit    Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit    Const DEST_TABLE = "tblUsers" 'change to suit    Const IMPORT_SPEC = "CSV_Import_Spec" 'change to suit    Const PATH_DELIM = "\"     'set to False if you DON'T want to move imported files to new folder    bArchiveFiles = True      'the FileSearch object lets you search a folder and, optionally its subfolders,     'for files of a defined type. It loads the names of all found files into an array,     'which we can use to import those files.     With Application.FileSearch      .NewSearch      .LookIn = TOP_FOLDER      .SearchSubFolders = False 'we only want to search the top folder      .FileName = "*.csv" 'change this to suit your needs      .Execute      FilesToProcess = .FoundFiles.Count       'check that files have been located. If not, display message and exit routine.      If FilesToProcess = 0 Then        MsgBox "No files found, nothing processed", vbExclamation        Exit Function      End If       For i = 1 To FilesToProcess        'import each file        DoCmd.TransferText acImportDelim, IMPORT_SPEC, DEST_TABLE, _          .FoundFiles(i), True        'archive the imported files        If bArchiveFiles Then          'code for archiving imported files...          sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))          sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)          sFileName = StrRev(sFileName)          sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _            & Format(Date, "yyyymmdd") & ".csv"          FileCopy .FoundFiles(i), sOutFile          Kill .FoundFiles(i)        End If      Next i    End With End Function  'The StrRev function reverses a text string. We are using it here to simplify  'extracting the file name: once the full path is reversed, we can pull out everything  'to the left of the first path delimiter. Reversing this string gives us the file name.  'Note: VBA has a StrReverse function that you can use instead of this custom function.  Function StrRev(sData As String) As String    Dim i As Integer    Dim sOut As String    sOut = ""    For i = 1 To Len(sData)       sOut = Mid(sData, i, 1) & sOut    Next i    StrRev = sOut End Function

 

[MSAccessRookie]

I think it might look something like this:

Function ImportCSVFiles()
 
    Dim FilesToProcess As Integer
    Dim i As Integer
    Dim bArchiveFiles As Boolean
    Dim sFileName As String
    Dim sOutFile As String
    Const TOP_FOLDER = "H:\Test" 'adjust folder name to suit
    Const ARCHIVE_FOLDER = "H:\Test\Imported" 'adjust folder name to suit
    Const DEST_TABLE = "tblUsers" 'change to suit
    Const IMPORT_SPEC = "CSV_Import_Spec" 'change to suit
    Const PATH_DELIM = "\" 'set to False if you DON'T want to move imported files to new folder
 
    bArchiveFiles = True
    'the FileSearch object lets you search a folder and, optionally its subfolders,
    'for files of a defined type. It loads the names of all found files into an array,
    'which we can use to import those files.
 
    With Application.FileSearch
        .NewSearch
        .LookIn = TOP_FOLDER
        .SearchSubFolders = False 'we only want to search the top folder
        .FileName = "*.csv" 'change this to suit your needs
        .Execute FilesToProcess = .FoundFiles.Count
 
        'check that files have been located. If not, display message and exit routine.
 
        If FilesToProcess = 0 Then
            MsgBox "No files found, nothing processed", vbExclamation
            Exit Function
        End If
 
        For i = 1 To FilesToProcess 'import each file
            DoCmd.TransferText acImportDelim, IMPORT_SPEC, DEST_TABLE, _
                .FoundFiles(i), True 'archive the imported files
            If bArchiveFiles Then 'code for archiving imported files...
                sFileName = StrRev(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4))
                sFileName = Left(sFileName, InStr(1, sFileName, PATH_DELIM) - 1)
                sFileName = StrRev(sFileName)
                sOutFile = ARCHIVE_FOLDER & PATH_DELIM & sFileName & " " _
                & Format(Date, "yyyymmdd") & ".csv"
                FileCopy .FoundFiles(i), sOutFile
                Kill .FoundFiles(i)
            End If
        Next i
    End With
End Function
 
    'The StrRev function reverses a text string. We are using it here to simplify
    'extracting the file name: once the full path is reversed, we can pull out everything
    'to the left of the first path delimiter. Reversing this string gives us the file name.
    'Note: VBA has a StrReverse function that you can use instead of this custom function.
 
Function StrRev(sData As String) As String
    Dim i As Integer
    Dim sOut As String
 
    sOut = ""
    For i = 1 To Len(sData)
        sOut = Mid(sData, i, 1) & sOut
    Next i
    StrRev = sOut
End Function