Struggling to write code to import all files in a folder to an Access Table

[kmarks247]

Hello,

I use to have a database I built several years ago that had a macro using VBA to import all text files in a folder (C:\Data\Reports\Inventory Reports) to a table in Access (Aeppays Daily Consolidated). I had a specification created (DailyAeppayImport) to import the files as delimited and it worked perfectly. After a profile rebuild by my company, I no longer have the database and have struggled now searching online for help as to how I can recreate this code. Any help at all would be greatly appreciated. It just needs to import all the text files (example name: AADMIN-863826.AEPPAYS-HOLDRPT-PASS-FWD.20170616020528.txt) whose names change daily into a single table in Access.

[ADezii]

For the sake of argument, let's assume that all of your Text Files are in a Folder named Test, namely C:\Test\*.txt. Let's also assume that you previously have defined your Import Specifications and named it My Import Specs. This specification will append all Data within all Text Files in the C:\Test\ Folder to a Table named tblResults. The Code to retrieve all Text Files in C:\Test\ and append their contents to tblResults using My Import Specs Specification is:

Dim strFilespec As String
Dim strPath As String
 
strPath = "C:\Test\"
strFilespec = "*.txt"
 
strFilespec = Dir(strPath & strFilespec, vbNormal)
 
Do While strFilespec <> ""
  DoCmd.TransferText acImportDelim, "My Import Specs", "tblResults", strPath & strFilespec
    strFilespec = Dir
Loop

P.S. - Change the Value of strPath and the name of your Import Specification as appropriate.

[NeoPa]

That sounds very unfortunate. Maybe a silly question, but have you tried asking IT if they have backups of your old profile etc? Having to recreate from scratch could turn out to be a lot of work. Frustrating purely to arrive back at where you started.

[kmarks247]

Yeah tell me about it, it has been an incredibly frustrating path to go down.

[kmarks247]

I've utilized the code given to me by ADezii (Thank you very much for your time) and have inserted this code to work on the click of a button from my main form.

I get the following error: Run-time error '2498':

An expression you entered is the wrong data type for one of the arguments.

My code currently sits as follows:

Option Compare Database
 
Private Sub Command0_Click()
 
Dim strFilespec As String
Dim strPath As String
 
strPath = "\\tamp-oa-001\TAMJCAReportPortfolio\Aeppays\Aeppays Text Files\"
strFilespec = "*.txt"
 
strFilespec = Dir(strPath & strFilespec, vbNormal)
 
Do While strFilespec <> ""
  DoCmd.TransferText , acImportDelim, "DailyAeppayImport", "DailyAeppaysConsolidated", strPath & strFilespec
    strFilespec = Dir
Loop
 
End Sub

**I am importing 82 .txt files all with different names. Here is an example of one of them - "AADMIN-863826.AEPPAYS-HOLDRPT-PASS-FWD.20170627023017.txt"

Could it be an issue with the file name?

[PhilOfWalton]

This may help with your initial question.

    ' Requires reference to Microsoft Office 14.0 Object Library. '
Public Function ShowFileDialog(FileType As Boolean, Flters() As String, Optional Filename As String, Optional Prompt As String) As String
 
    Dim fDialog As Office.FileDialog
    Dim varFile As Variant
    Dim FileStg As String
    Dim i As Integer, j As Integer
    Dim StrFilter1 As String, StrFilter2 As String
 
    ' Set up the File Dialog. '
    If FileType = True Then                  ' Files
        Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
        With fDialog
            ' Clear out the current filters, and add our own.'
            .filters.Clear
            i = UBound(Flters)
            If (i <> -1) Then
                For j = 0 To i - 1
                    StrFilter1 = Flters(j)
                    If (Int(i + 1) / 2) * 2 = i + 1 = True Then
                        StrFilter2 = Flters(j + 1)
                        If StrFilter2 > "" Then
                            If Left(StrFilter2, 1) <> "*" Then
                                StrFilter2 = "*" & StrFilter2
                            End If
                            If Mid(StrFilter2, 2, 1) <> "." Then
                                StrFilter2 = Left(StrFilter2, 1) & "." & right(StrFilter2, Len(StrFilter2) - 1)
                            End If
                        End If
                    End If
                    If StrFilter1 > "" And StrFilter2 > "" Then
                        .filters.Add StrFilter1, StrFilter2
                    End If
                Next j
            End If
            .filters.Add "All Files", "*.*"
 
        End With
    Else                                    ' Folders
        Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    End If
 
    With fDialog
        ' Set the title of the dialog box. '
        .Title = Prompt
        .InitialView = msoFileDialogViewDetails
        If Filename = "" Then
            .InitialFileName = CurDir
        Else
            .InitialFileName = Filename
        End If
 
        ' Allow user to make multiple selections in dialog box '
        .AllowMultiSelect = False
 
        ' Show the dialog box. If the .Show method returns True, the '
        ' user picked at least one file. If the .Show method returns '
        ' False, the user clicked Cancel. '
        If .Show = True Then
            'Loop through each file selected and add it to our list box. '
            For Each varFile In .SelectedItems
                'Me.FileList.AddItem varFile
                FileStg = varFile
                'Debug.Print varFile
            Next
        Else
            ShowFileDialog = ""
            Exit Function
        End If
    End With
 
    If FileType = False Then                    ' Folders
        i = InStrRev(FileStg, ".")              ' Look for a dot
        j = InStrRev(FileStg, "\")              ' Look for a slash
        If i = 0 Then
            ShowFileDialog = FileStg            ' No dot so should be a folder
        End If
    Else
        ShowFileDialog = FileStg
    End If
 
End Function
 

and here is a test function

Function TestShowFileDialog() As String
 
    Dim FileType As Boolean             ' True = File, False = Folder
    Dim Filename As String
    Dim Prompt As String
 
    Dim FilterArray(3) As String
 
    FileType = True                 ' File
 
    FilterArray(0) = "Databases"
    FilterArray(1) = ".AccDb"
    FilterArray(2) = "Databases"
    FilterArray(3) = ".Mdb"
 
    TestShowFileDialog = ShowFileDialog(True, FilterArray(), "C*", "Where is the file C?")
 
End Function
 

You may also need additional code to loop through all subfolders

As to your problem, I suspect the file name and in particular the dots between 863826 and AEPPAYS and between FWD and 20170627023017after in your example

Phil

[NeoPa]

KMarks:
Yeah tell me about it, it has been an incredibly frustrating path to go down.

Interesting comment, but falls shy of answering the question. Can I assume you have asked them? What was their response?

[NeoPa]

KMarks:
I get the following error: Run-time error '2498':

An expression you entered is the wrong data type for one of the arguments.

What line of your code does this occur on?

A further comment is covered by Require Variable Declaration.

KMarks:
Could it be an issue with the file name?

Not impossible, but let's look at it in order and get the basics right first, before we move on to explore other things if necessary.

[kmarks247]

NeoPa, sorry yes our IT department was the first place I went to. They were the ones who notified me that my previous files and databases were lost beyond repair. It sounded like it was due to us using thin clients and floating profiles? I'm not smart enough honestly to know how true that is exactly.

[kmarks247]

NeoPa, this line in particular is the one highlighted when I get the error:

DoCmd.TransferText , acImportDelim, "DailyAeppayImport", "DailyAeppaysConsolidated", strPath & strFilespec

[kmarks247]

Just as a test I built a quick macro to ImportExportText utilizing the first text file I want to import. I see already that I get an error that it can't find the name it's looking for. I'm beginning to think the file names that are automatically posted for us each day are the issue. AADMIN-863826.AEPPAYS-HOLDRPT-PASS-FWD.20170628025319.txt is an example of one. Each one is this file name format.

[PhilOfWalton]

Well why not have just 2 or 3 files in your folder as a test and change the name to XXX.Txt, yyy.Txt & zzz.Txt, and see if that imports OK.

That will establish whether my theory that the only "." you can have in a file name is just before the file suffix.

Phil

[ADezii]

1. As PhilOfWalton suggests, you are getting Errors because of the Period('.') in the Filenames, not including the Extensions(*.txt).
2. There is, however, a solution and here it goes:
   1. For each File, store it's Original Name (Absolute Path) in a Variable.
   2. Replace each Period('.') with an Empty Space(""), Replace the txt at the end of the Filename (period was removed) with .txt and assign this New Name to a Variable.
   3. Perform the TransferText() Operation on the New Filename stored in strNewName.
   4. After this Operation, Rename the New Filename back to the Original Filename.
3. Example of Renaming Procedure:
   

   ‘File 1 (original Name)
   C:\TEMP\AADMIN-443826.AEPPAYS-HOLDRPT-PATSS-FWD.20170627023017.txt    
   ‘File 1 (New Name after Replace(), period removed, txt removed, .txt added)
   C:\TEMP\AADMIN-443826AEPPAYS-HOLDRPT-PATSS-FWD20170627023017.txt
    
   ‘File 2 (original Name)
   C:\TEMP\AADMIN-863826.AEPPAYS-HOLDRPT-PASS-FWD.20170627023017.txt 
   ‘File 2 (New Name after Replace(), period removed, txt removed, .txt added)  
   C:\TEMP\AADMIN-863826AEPPAYS-HOLDRPT-PASS-FWD20170627023017.txt
    
   ‘File 3 (original Name)
   C:\TEMP\AADMIN-8638926.AEPPAYS-HOLYDRPT-PASS-FWD.20170627023017.txt   
   ‘File 3 (New Name after Replace(), period removed, txt removed, .txt added)
   C:\TEMP\AADMIN-8638926AEPPAYS-HOLYDRPT-PASS-FWD20170627023017.txt

4. Code Definition:
   

   Dim strFilespec As String
   Dim strPath As String
   Dim strOriginalName As String
   Dim strNewName As String
    
   strPath = "C:\TEMP\"
   strFilespec = "*.txt"
    
   strFilespec = Dir(strPath & strFilespec, vbNormal)
    
   Do While strFilespec <> ""
     strOriginalName = strPath & strFilespec
     strNewName = Replace(Replace(strPath & strFilespec, ".", ""), "txt", ".txt")
       Debug.Print strOriginalName, strNewName
         Name strOriginalName As strNewName
           DoCmd.TransferText acImportDelim, "MyImportSpec", "Table1", strNewName, True
         Name strNewName As strOriginalName
    
         strFilespec = Dir
   Loop
    

[NeoPa]

KMarks:
DoCmd.TransferText , acImportDelim, "DailyAeppayImport", "DailyAeppaysConsolidated", strPath & strFilespec

You'll notice that the first parameter is preceeded by a comma (,). This means that the value for your first parameter (TransferType) is actually being passed in the second (SpecificationName) instead. obviously, with positional parameters, this is also true of all subsequent parameters.

I always recommend using named parameters when calling procedures, but it's particularly helpful when dealing with those that have quite a few, as well as those which have optional ones. Following that approach would certainly have avoided this little problem.

[NeoPa]

KMarks:
NeoPa, sorry yes our IT department was the first place I went to. They were the ones who notified me that my previous files and databases were lost beyond repair. It sounded like it was due to us using thin clients and floating profiles? I'm not smart enough honestly to know how true that is exactly.

That's fair enough. Generally the profile is quite separate from you files, but not always if files are stored in the wrong places. They frequently are. Very few ever get advice or guidance on where to, and not to, store their data.

It may be worth another stab at asking particularly for your old profile, but like you I'd expect that to turn up nothing of value, from what you've already said.

[NeoPa]

Also, it seems ADezii has already checked out Phil's suggestion for you and confirmed his suspicion. Not only that, but in true ADezii style, has designed some code that will help you to get past this particular problem. Try it out and I suspect you'll be wanting to set his answer as the Best Answer when you've got it to work.