Excel VBA to select a folder and load the TXT files inside

Question

Below is part of the code I have that will request user to select a .txt file they want, and it will load to the excel, is it possible to let user select a folder where there is multiple .txt file inside and it will load to the excel? Example, there is a folder named log, inside have log1.txt, log2.txt, etc. User will select folder named log and all the txt files inside will be recorded to the excel sheet I have. Or is there a method whereby I can loop the macro I have based on the number of txt file I have in the folder so it will record each txt file respectively on the excel sheet.

    textFileLocation = Application.GetOpenFilename()
    textDelimiter = ","
    textFileNum = FreeFile
    Open textFileLocation For Input As textFileNum
    textData = Input(LOF(textFileNum), textFileNum)
    Close textFileNum
    tArray() = Split(textData, vbLf)
    For rowNum = LBound(tArray) To UBound(tArray) - 1
        If Len(Trim(tArray(rowNum))) <> 0 Then
            sArray = Split(tArray(rowNum), textDelimiter)
            For colNum = LBound(sArray) To UBound(sArray)
                ActiveSheet.Cells(rowNum + 1, colNum + 1) = sArray(colNum)
            Next colNum
        End If
    Next rowNum

    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers _
    :=True

Answer 1

Please, try the next piece of code. It let you chose the folder to be processed, then iterate between all existing text files, place their content in an array, drop the content in the calculated last row and finally apply TextToColumns. It considers comma as columns separator:

Sub ProcessFilesFromChosenFolder()
  Dim textFileLocation As String, textDelimiter As String, fileName As String, arrTxt
  Dim ws As Worksheet, lastR As Long
  
  Set ws = Application.ActiveSheet 'use here the sheet you need
  textFileLocation = GetFolderName("This PC") 'if you need it to be open in a specific folder, place here its path
  
  fileName = Dir(textFileLocation & "\*.txt") 'first text file  name
  
  If fileName <> "" Then
    Do While fileName <> ""    'loop since there still are not processed text files
        'place the content of the text file in an array (split by VbCrLf):
        arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileLocation & "\" & fileName, 1).ReadAll, vbCrLf)
        lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'the row where to paste the array content

        'drop the transposed array content:
        ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
        
        fileName = Dir 'find the next text file
    Loop
  End If
  'apply TextToColumns to whole returned data:
  ws.Columns(1).TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, ConsecutiveDelimiter:=False, Comma:=True, _
             FieldInfo:=Array(Array(0, 1), Array(43, 1), Array(70, 1)), TrailingMinusNumbers:=True
End Sub

Function GetFolderName(InitPath As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)

        If InitPath <> "" Then
            If Right$(InitPath, 1) <> "\" Then
                InitPath = InitPath & "\"
            End If
            .InitialFileName = InitPath
        Else
            .InitialFileName = ""   'it starts at This PC...
        End If
        
        If .Show() = True Then
            If .SelectedItems.count > 0 Then
                GetFolderName = .SelectedItems(1)
            End If
        End If

    End With
End Function

Edited:

The next version does not need TextToColumns it splits each initial array row by delimiter (comma) and load a third final array to drop its content after each processed text file:

Sub ProcessFilesFromChosenFolderBis()
  Dim textFileLocation As String, fileName As String, ws As Worksheet, lastR As Long
  Dim arrTxt, arrLine, ColsNo As Long, arrFin, i As Long, j As Long
  Const textDelimiter As String = ","
  
  Set ws = Application.ActiveSheet 'use here the sheet you need
  textFileLocation = GetFolderName("This PC") 'if you need it to be open in a specific folder, place here its path
  
  fileName = Dir(textFileLocation & "\*.txt") 'first text file  name
  
  If fileName <> "" Then
    Do While fileName <> ""    'loop since there still are not processed text files
        'place the content of the text file in an array (split by VbCrLf):
        arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileLocation & "\" & fileName, 1).ReadAll, vbCrLf)
        ColsNo = UBound(Split(arrTxt(0), textDelimiter)) + 1 ' determine number of columns
        ReDim arrFin(1 To UBound(arrTxt) + 1, 1 To ColsNo)   'redim the aray to keep the processed data

        For i = 0 To UBound(arrTxt)
            arrLine = Split(arrTxt(i), textDelimiter) 'place each row/line in an array
            For j = 0 To UBound(arrLine): arrFin(i + 1, j + 1) = arrLine(j): Next j 'load final array
        Next i
        
        lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'the row where to paste the array content
        'drop the processed final array content:
        ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
        
        fileName = Dir 'find the next text file
    Loop
  End If
  MsgBox "Ready..."
End Sub

It uses the same function to determine the folder to be processed.

Second Edit: The next code needs you to select a text file from the folder you need processing. It does not need the function to browse for folder, anymore:

Sub ProcessFilesFromChosenFolderBis()
  Dim textFileLocation As String, fileName As String, ws As Worksheet, lastR As Long
  Dim arrTxt, arrLine, ColsNo As Long, arrFin, i As Long, j As Long, FullPath
  Const textDelimiter As String = ","
  
  Set ws = Application.ActiveSheet 'use here the sheet you need
  
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Text Files", "*.txt", 1
        If .Show = -1 Then
             FullPath = .SelectedItems.Item(1) 'selected text file full path
        End If
  End With
  If FullPath = "" Then Exit Sub 'if Cancel pressed, the code stops
  
  textFileLocation = Left(FullPath, InStrRev(FullPath, "\") - 1)
  fileName = Dir(textFileLocation & "\*.txt") 'first text file  name
  
  If fileName <> "" Then
    Do While fileName <> ""    'loop since there still are not processed text files
        'place the content of the text file in an array (split by VbCrLf):
        arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileLocation & "\" & fileName, 1).ReadAll, vbCrLf)
        ColsNo = UBound(Split(arrTxt(0), textDelimiter)) + 1 ' determine number of columns
        ReDim arrFin(1 To UBound(arrTxt) + 1, 1 To ColsNo)   'redim the aray to keep the processed data

        For i = 0 To UBound(arrTxt)
            arrLine = Split(arrTxt(i), textDelimiter) 'place each row/line in an array
            For j = 0 To UBound(arrLine): arrFin(i + 1, j + 1) = arrLine(j): Next j 'load final array
        Next i
        
        lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'the row where to paste the array content
        'drop the processed final array content:
        ws.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin: 'Stop
        
        fileName = Dir 'find the next text file
    Loop
  End If
  MsgBox "Ready..."
End Sub