Loop through all Sub Folders & copy data in .txt files into individual tabs 1

Nick V · Oct 10, 2018

Hi all,

Quickly : There are folders for each month of the calendar year and in those month's folders are sub-folders which belong to various companies. In the company's folder are more folders which holds .txt files that I need the the contents to be extracted from.

Essentially, in folder "03 March" there is a folder for company "Company Excel" and inside that company folder is the Workbook "03 March 2018 Company Excel.xlsm". This .xlsm file will look at all sub-folders within "Company Excel" folder (in "03 March") and copy the contents of all .txt files and paste it in their own individual tabs (with the tabs being labelled with the .txt filename). Within "03 March 2018 Company Excel" there is a tab calld "Master" which will remain blank.

Could the macro possibly not be directory specific? As going forward, I believe it would be best to copy the previous months' .xlsm file for the next month and would like to avoid having to rename the filepath in the code.

When copying the contents of the .txt files, could the name of the .txt files be put against the pasted contents?
Just as a rough idea, some .txt files contents could range from 0 - over 1,000 lines.

As a side note: there are folders called "Unsuccessful" which has .pdf files. I would like for their filenames to be pasted in a new tab with the same name as the folder. There are also .pdf files in the date folders (mentioned above) which I would like their filenames to be pasted in a tab called "Successful". (Maybe it would be easier to have those .pdf files in a folder called "Successful"?)

I think this is a big ask so thank you in advance!!!

Nick V · Oct 16, 2018

Code:

Sub EditTextImport_FAO_SKIP()
'

'

'
    Range("A6:H13").Select
    With Selection.QueryTable
        .Connection = _
        "TEXT;C:\Park\Remittance .txt Invoice .pdf\2018\09 September\Ross and Roberts\11 09 2018 LBCRT\BAILIFFROSSANDROB10092018.txt"
        .CommandType = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 2, 4, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(3, 10, 10, 10, 8, 8, 42)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

SkipVought · Oct 16, 2018

This will be a new procedure along with the other two.

Code:

Sub GetIMPORT([b]oFile[/b] As File)
    
    With [b][BAILIFFROSSANDROB10092018_1].[/b]QueryTable
        .Connection = [b]oFile.Value[/b]
        .CommandType = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 2, 4, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(3, 10, 10, 10, 8, 8, 42)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

In addition make these changes in your first two procedures in the Case "txt"

Code:

'...
        Select Case Split(oFile.Name, ".")(1)
            Case "txt"
                [b]GetIMPORT oFile[/b]
            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
'...

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

SkipVought · Oct 16, 2018

At this point you ought to be able to run the FolderDrillDown and get all your text files into the Master, except for a few tweeks. I think this will work for you, to modify my previous post...

Code:

'...
        Select Case Split(oFile.Name, ".")(1)
[b]            Case "txt"
                GetIMPORT oFile
                
                [BAILIFFROSSANDROB10092018_1].Copy
                With Sheets("Master")
                    lRow = .UsedRange.Row + .UsedRange.Rows.Count
                    .Cells(lRow, "A").PasteSpecial xlPasteValues
                End With
[/b]            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
'...

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Nick V · Oct 16, 2018

There is an error against:

Code:

.Connection = oFile.Value

With .Value highlighted.

Error Message : Compile error: Method or data member not found.

Thereafter, Sub GetIMPORT(oFile As File) is highlighted in yellow.

Also, why does your query table include "_1"?

With [BAILIFFROSSANDROB10092018_1].QueryTable

Thanks.

SkipVought · Oct 16, 2018

Sorry.

[tt]
.Connection = oFile.Name
[/tt]

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

SkipVought · Oct 16, 2018

Also, why does your query table include "_1"?

Select your IMPORT sheet.

Select the Drop Down button in the Name Box and then the BAILIFF.... name.

Select the BAILIFF.... name again. The SECOND select will display the LAST portion of the name.

Mine shows SANDROB10092018_1.

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Nick V · Oct 16, 2018

I see.

Data > Name Manager > (Only one there) BAILIFF...name > Edit > BAILIFFROSSANDROB10092018_1.

After amending oFile.Name an error pops up : Run-time error '1004': Application-defined or object-defined error.
Selecting Debug highlights .Connection = oFile.Name

SkipVought · Oct 16, 2018

Didn’t refer to the Name Manager. Nothing should be changed in the Name Manager!

The Name Box is just above column A, usually displaying the Active Cell.

Please go back an go thru the process previously outlined to determine for certain what YOUR data range is currently named AND that it references the proper range on the IMPORT sheet.

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Nick V · Oct 16, 2018

Apologies for the confusion - when I select the Delimited range, the name box does come up with BAILIFFRO....

I have not changed any ranges or names.

[/Run-time error '1004': Application-defined or object-defined error.
Selecting Debug highlights .Connection = oFile.Namequote]

SkipVought · Oct 16, 2018

Plz COPY everything in the module that you’re using and PASTE here. That should include all three procedures we’ve been referring to.

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Nick V · Oct 17, 2018

Code:

Sub FolderDrillDown()
        
    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim oFLDR  As Folder
    Dim oFile As File
    Dim s As String, folderspec As String
    
    
    Worksheets("Import").Activate
    
    folderspec = "C:\Park\Remittance .txt Invoice .pdf\2018\\"     '<<<MODIFY THIS PATH
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    Set oFolder = oFSO.GetFolder(folderspec)
    
    For Each oFile In oFolder.Files
        Select Case Split(oFile.Name, ".")(1)
            Case "txt"
                GetIMPORT oFile
                
                [BAILIFFROSSANDROB10092018_1].Copy
                With Sheets("Master")
                    lRow = .UsedRange.Row + .UsedRange.Rows.Count
                    .Cells(lRow, "A").PasteSpecial xlPasteValues
                End With
            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
'        Select Case Split(oFile.Name, ".")(1)
 '           Case "txt"
                
                'Debug.Print oFolder.Name, oFile.Name
  '          Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
      '  End Select
    Next
    
    GetSubFolder oFolder
End Sub

Sub GetSubFolder(oFLDR As Folder)
    Dim oFolder  As Folder
    Dim oFile As File
        
    For Each oFolder In oFLDR.SubFolders
        For Each oFile In oFolder.Files
        Select Case Split(oFile.Name, ".")(1)
            Case "txt"
                GetIMPORT oFile
                
                [BAILIFFROSSANDROB10092018_1].Copy
                With Sheets("Master")
                    lRow = .UsedRange.Row + .UsedRange.Rows.Count
                    .Cells(lRow, "A").PasteSpecial xlPasteValues
                End With
            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
        Next
        
        GetSubFolder oFolder
    Next
     
End Sub



Sub GetIMPORT(oFile As File)
    
    With [BAILIFFROSSANDROB10092018_1].QueryTable
        .Connection = oFile.Name
        .CommandType = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 2, 4, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(3, 10, 10, 10, 8, 8, 42)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

SkipVought · Oct 19, 2018

Sorry, been out and about running errands. I’ll be out again today. I’ll be checking periodically.

Please read the FAQ linked below. It’s a way to observe what’s happening in your code when it runs. At the point of either a planned BREAK or when the running code stops, you can hit the DeBug button and then use the Watch Window to see what values are held by variables and Objects.

FAQ707-4594

My code ran, drilling down into two levels and accumulating data from those files into the Master table. So far I can’t see what’s wrong with what you posted. But, sadly, I haven’t had time to do justice to that analysis.

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Andrzejek · Oct 19, 2018

Nick V,
You can also try this approach. Have a new Excel file with just one worksheet.
Add the reference to Microsoft Scripting Runtime Library

Based on your sample of the txt file, I assume what you want is: ignore first line of text, get the pieces from the rest of the txt file.

For some reason you had a header row in row 5 and your data started in row 6 (?) that's why I have [tt]intRow = 6[/tt] in this code. You would have to provide your own header row (5), and possibly clean the data before grabbing new data. But that's easy. As well as setting some hyperlinks to locations of your files. Or formatting the dates as date, not just text.

Also, I don't know what you want to do with PDF files, how to deal with /display them in Excel

And try this code:

Code:

Option Explicit
Dim intR As Integer

Sub FolderDrillDown()
        
    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim oFLDR  As Folder
    Dim oFile As File
    Dim s As String, folderspec As String
    
    intR = 6
[green]
    'Worksheets("Import").Activate[/green]
    
    folderspec = "[red]E:\Andrzej\TT\Sample_Files[/red]"  [green]'CHANGE THIS[/green]
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    Set oFolder = oFSO.GetFolder(folderspec)
    
    For Each oFile In oFolder.Files
        Select Case Split(oFile.Name, ".")(1)
            Case "txt"
                Call GrabDataFromTXT(oFolder.Path, oFile.Name)

            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
    Next
    
    GetSubFolder oFolder
End Sub

Sub GetSubFolder(oFLDR As Folder)
    Dim oFolder  As Folder
    Dim oFile As File
        
    For Each oFolder In oFLDR.SubFolders
        For Each oFile In oFolder.Files
        Select Case Split(oFile.Name, ".")(1)
            Case "txt"
                Call GrabDataFromTXT(oFolder.Path, oFile.Name)
            Case "pdf"
                'Debug.Print oFolder.Name & "__", ">>"; oFile.Name, "<<"
        End Select
        Next
        
        GetSubFolder oFolder
    Next
     
End Sub

Public Sub GrabDataFromTXT(ByRef strFPath As String, ByRef strFName As String)
Dim strTextLine As String
Dim strCase As String
Dim lngAmt As Long
Dim strInvDate As String
Dim strRef As String
Dim strCompany As String
Dim blnOkToProcess As Boolean

Open strFPath & "\" & strFName For Input As #1
Do While Not EOF(1)
    strCase = ""
    lngAmt = 0
    strInvDate = ""
    strRef = ""
    strCompany = ""
    
    Line Input #1, strTextLine
    If blnOkToProcess Then
        strCase = Mid(strTextLine, 4, 10)
        lngAmt = Val(Mid(strTextLine, 25, 9))
        strInvDate = Mid(strTextLine, 34, 8)
        strRef = Mid(strTextLine, 42, 8)
        strCompany = Trim(Mid(strTextLine, 51))
        
        Range("A" & intR & ":G" & intR).Value = Array( _
            strCase, lngAmt, strInvDate, strRef, strCompany, _
            strFName, strFPath)
        intR = intR + 1
    End If
    blnOkToProcess = True
Loop
Close #1

End Sub

I talked to Skip about my code and in his opinion: "It’s just another method in the toolbox."

---- Andy

There is a great need for a sarcasm font.

Nick V · Oct 19, 2018

Hi Andy,

Firstly, thank you for pasting your code. It worked! I used a month with only two .txt files to test.

I will need to eventually, have the '+' in front of the amount (as rarely, there can be a '-'). Is there a way this can be implemented within the coding?

As well as setting some hyperlinks to locations of your files. Or formatting the dates as date, not just text.

I'll do some research on how to set up hyperlinks to the location of the files.
Assuming I can format the dates after the code has brought in the data? Or would it be easier to do it in one go?

Also, I don't know what you want to do with PDF files, how to deal with /display them in Excel

In a separate tab, I would have the filename of the PDF (as it starts with the unique case number).
The directory of the PDF file as a hyperlink for quick access.

The problem with the PDF files is that the companies don't send them in the same format.

:::

There is another variable problem but not all that fussed however:

CC12345678 | 20300 | 25012018 | 8fb782d1 | 4ecf-888e-d068-7ab31afd51f0 Payment to JWB | .txt name | directory
CC34567890 | 9266 | 23012018 | 20441887 | Payment to Ross & Robs | .txt name | directory

As you can see from the two different companies invoice samples, they differ. Starts off lovely and then in the middle it goes slightly redundant I suppose.
The first three columns are important. The fourth for Ross & Robs is their reference number for that case. You think, when cleaning the data into another tab (if that is the correct method?) to put a formula which would extract the text of the company which would then leave the reference number?

Thanks so very much the both of you. Apologies for the difficulties I may have caused.

Andrzejek · Oct 19, 2018

have the '+' in front of the amount (as rarely, there can be a '-'). "

Modify one line of code to:
[tt]lngAmt = Val(Mid(strTextLine,[blue] 24, 10[/blue]))[/tt]
You will not get the +, but you should get the '-' which should be ok since Excel does not have + in front of positive numbers, right?

"Assuming I can format the dates after the code has brought in the data? Or would it be easier to do it in one go?"

You can do it in one go -

Code:

....[blue]
Dim datDate As Date[/blue]
...
        lngAmt = Val(Mid(strTextLine, 25, 9))[blue]
        datDate = DateSerial(Mid(strTextLine, 38, 4), Mid(strTextLine, 36, 2), Mid(strTextLine, 34, 2))[/blue]
        strRef = Mid(strTextLine, 42, 8)
        strCompany = Trim(Mid(strTextLine, 51))
        
        Range("A" & intR & ":G" & intR).Value = Array( _
            strCase, lngAmt, [blue]datDate[/blue], strRef, strCompany, _
            strFName, strFPath)
        intR = intR + 1

---- Andy

There is a great need for a sarcasm font.

Nick V · Oct 20, 2018

Thanks Andy,

Changed the code and when running it errors: Run-time error '13': Type mismatch.
And the following is highlighted in yellow:

datDate = DateSerial(Mid(strTextLine, 38, 4), Mid(strTextLine, 36, 2), Mid(strTextLine, 34, 2))

I will fiddle with extracting the company names from the string of text.

SkipVought · Oct 20, 2018

DateSerial wants NUMBERS as arguments...

Code:

datDate = DateSerial(Cint(Mid(strTextLine, 38, 4)), cint(Mid(strTextLine, 36, 2)), cint(Mid(strTextLine, 34, 2)))

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Nick V · Oct 20, 2018

Hi Skip

Same error type and the new line of code is highlighted in yellow.

Is there something I am doing incorrectly?

SkipVought · Oct 20, 2018

Put a BREAK on that line. Run to the BREAK.

SELECT each MID()...

Code:

datDate = DateSerial(Cint([b]Mid(strTextLine, 38, 4)[/b]), cint(Mid(strTextLine, 36, 2)), cint(Mid(strTextLine, 34, 2)))

..and observe what is returned in the Watch Window.

Should be the YEAR, MONTH & DAY values.

Skip,
[sub]
[glasses]

Just traded in my OLD subtlety...
for a NUance! [tongue]

[/sub]

Andrzejek · Oct 22, 2018

What Skip is saying, you should get the valid data this way:

Code:

Debug.Print "The Year  is " & Cint(Mid(strTextLine, 38, 4))
Debug.Print "The Month is " & Cint(Mid(strTextLine, 36, 2))
Debug.Print "The Day   is " & cint(Mid(strTextLine, 34, 2))

datDate = DateSerial(Cint(Mid(strTextLine, 38, 4)), cint(Mid(strTextLine, 36, 2)), cint(Mid(strTextLine, 34, 2)))

Based on the txt file you have provided with the [blue]date[/blue] in it here:

[pre]
HROSSANDROB19022018000000000001+000060900
D01CC90779398 +000020300[blue]13022018[/blue]20751445 Payment to Ross & Robs
D01CC90779312 +000020300[blue]13022018[/blue]20751125 Payment to Ross & Robs
D01CC90779337 +000020300[blue]13022018[/blue]20751778 Payment to Ross & Robs

[/pre]

---- Andy

There is a great need for a sarcasm font.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Loop through all Sub Folders &amp; copy data in .txt files into individual tabs 1

Technical User

Technical User

Programmer

Programmer

Technical User

Programmer

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor

Loop through all Sub Folders & copy data in .txt files into individual tabs 1