Use VBA to loop through all the .txt files in a folder, then transfer the content to an excel sheet

[EmmaG]

This is the base code. This code works perfectly fine. It reads data from a .txt file and import the first 160 columns to an excel sheet. This code can be re-used on multiple files (doing data importing and appending). For example, the first time I run this code, it will import all the data from the first selected .txt file to my spreadsheet. Then, if I change the file path, and run it again, it will ignore the header row of the second file (more accurately, all the files except the first selected file), and APPEND all the data from the second selected .txt file to the existing excel sheet.

Private Sub CopyLessColumns() 'it copies less columns than the txt file has
 Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
 Dim fso As Object, txtStr As Object, strText As String 'no need of any reference

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = " C:\Users\xxxxxx\Desktop\Forecast1.txt"
  If Dir(strSpec) <> "" Then 'check if file exists
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
  End If
  arrSp = Split(strText, vbCrLf)

    colToRet = 160 'Number of columns to be returned
    lastR = ActiveSheet.Range("A" & Rows.count).End(xlUp).Row 'last row in A:A
    'arrRez is dimensioned from 0 to UBound(arrSp) only for lastR = 1
    ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
    For i = IIf(lastR = 1, 0, 1) To UBound(arrSp) 'Only in case of larR = 1, the
                                                  'head of the table is load in arr
      arrInt = Split(arrSp(i), vbTab)  'each strText line is split in an array
      If UBound(arrInt) > colToRet - 1 Then
          For j = 0 To colToRet - 1
              arrRez(i, j) = arrInt(j) 'each array element is loaded in the arrRez
          Next j
      End If
    Next i
    'The array is dropped in the dedicated range (calculated using Resize):
    ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
                                                UBound(arrRez, 2) + 1).Value = arrRez
End Sub

What I am trying to do is to store all the .txt files into a folder, then use vba loop function to loop through all the .txt files and execute the code above on them at once. So I don’t have to go in and change the file path every time I want to run this code on a different .txt file. This is what I have so far:

Sub readFiles()
    Dim file As String, fileCount As Integer

    Dim filePath As String
    filePath = "C:\Users\xxxxxx\Desktop\Forecast" 
    file = Dir$(filePath)
    fileCount = 0

    While (Len(file) > 0)
        fileCount = fileCount + 1
        ReadTextFile filePath & file, fileCount
        file = Dir
    Wend
End Sub


Sub ReadTextFile(filePath As String, n As Integer)
 Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
 Dim fso As FileSystemObject, txtStr As Object, strText As String                              

  Set fso = New FileSystemObject
  Set txtStr = fso.OpenTextFile(filePath, ForReading, False)

  Do While Not txtStr.AtEndOfStream
    arrSp = Split(strText, vbCrLf)

    colToRet = 160                                
        lastR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row                     

        ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
        For i = IIf(lastR = 1, 0, 1) To UBound(arrSp) 
        arrInt = Split(arrSp(i), vbTab)  
        If UBound(arrInt) > colToRet - 1 Then
            For j = 0 To colToRet - 1
                arrRez(i, j) = arrInt(j) 
            Next j
             End If
     Next i

        ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
                                                UBound(arrRez, 2) + 1).Value = arrRez
    Loop

    txtStr.Close
End Sub

Basically, I am trying to use the first sub to loop through all .txt files in the folder, then call the first sub with their path as a function parameter. But it is not working somehow. I don’t think there is anything wrong with the first (readFiles) sub…

In the second sub, as you can see in the code above, I replaced this part of the base code

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Teste VBA Excel\TextFileTabDel.txt"
  If Dir(strSpec) <> "" Then 'check if file exists
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
  End If

with this:

  Set fso = New FileSystemObject
  Set txtStr = fso.OpenTextFile(filePath, ForReading, False)

And I placed the rest of the base code into a do while loop.

If I run the VBA codes, I will NOT get any warning or error signs, but this message box will pop up. But if I click Run, nothing will happen.

I really don’t have a clue why this is not working, so any comments/hints would be appreciated!

 

[John_w]

Add a back slash to the end:

filePath = "C:\Users\xxxxxx\Desktop\Forecast\"