Importing multiple text files into one WS with copying the name of each file

[tenda]

Hi all,

I have about 22000 text files with data records located in hundreds of sub directories under one main directory. Each text file contains a group of records, where every record is in one line. Data are specific codes used internally.
For further data manipulation, I need to import all the data from all the text files into one worksheet, with the condition that the name of the file where the data came from, is to be copied next to each record imported from that file.
The following example shows two columns: ColA with repeated names of the first file in the same number of its records in ColB, and so forth.

ColA ColB
AQ-S2-T1 MCR-ALV-S2-208-3
AQ-S2-T1 MCR-ALV-S2-231-2
AQ-S2-T1 MCR-ALV-S2-196-13
AQ-S2-T1 MCR-ALV-S2-281-1
AQ-S2-T1 MCR-ALV-S2-269-2
AQ-S2-T1 MCR-ALV-S2-014-4
AQ-S2-T2 MCR-ALV-S2-091-9
AQ-S2-T2 SQ-SPR-S2-003
AQ-S2-T2 KAS-PC-S2-051
AQ-S2-T2 MCR-ALV-S2-083-9
AQ-S2-T2 MCR-ALV-S2-106-3

Any expert assistance with this issue is highly appreciated.

Many thanks in advance.

T.​

 

[John_w]

Try this macro - it assumes the text files have the extension ".txt". Edit the code where indicated to the path of the main folder.

Public Sub Import_All_Text_Files()

    Dim mainFolder As String
    Dim destCell As Range
    
    mainFolder = "C:\folder\path\"                        'CHANGE THIS - MAIN FOLDER PATH

    If Right(mainFolder, 1) <> "\" Then mainFolder = mainFolder & "\"
    
    With ActiveSheet
        .Cells.ClearContents
        Set destCell = .Range("B1")
    End With
    
    Import_Files_In_Folder mainFolder, destCell
    
End Sub


Private Function Import_Files_In_Folder(folderPath As String, destinationCell As Range) As Long
    
    Static FSO As Object
    Dim thisFolder As Object
    Dim thisFile As Object
    Dim subfolder As Object
    Dim rowOffset As Long, numRows As Long
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set thisFolder = FSO.GetFolder(folderPath)
    
    rowOffset = 0
    For Each thisFile In thisFolder.Files
        If LCase(thisFile.Name) Like "*.txt" Then
            numRows = Import_Text_File(thisFile.Path, destinationCell.Offset(rowOffset))
            destinationCell.Offset(rowOffset, -1).Resize(numRows, 1).Value = Left(thisFile.Name, InStrRev(thisFile.Name, ".") - 1)
            rowOffset = rowOffset + numRows
            DoEvents
        End If
    Next
    
    'Process subfolders
    
    For Each subfolder In thisFolder.SubFolders
        rowOffset = rowOffset + Import_Files_In_Folder(subfolder.Path, destinationCell.Offset(rowOffset))
    Next

    Import_Files_In_Folder = rowOffset
    
End Function


Private Function Import_Text_File(fileName As String, destinationCell As Range) As Long
    With destinationCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & fileName, Destination:=destinationCell)
        .Name = "text file"
        .RefreshStyle = xlInsertDeleteCells
        .Refresh BackgroundQuery:=False
        Import_Text_File = .ResultRange.Rows.Count
        .Delete
    End With
End Function

 

[tenda]

Dear John,
This is incredible, I mean incredible .. you made me speechless ..
You masterpiece script worked like charm. It did as exactly as it is needed for, smoothly and quickly. I really don't know what to say.
Please accept my deep gratitude and respect for your genuine person.
Thanks very much John ..

T.

 

[John_w]

Thanks! It always helps when the 'spec' is clear, so I'm pleased that it works as required.

 

[tenda]

Dear John,

As I was working on importing text files, I encountered files containing English and Arabic texts together in the same records. After importing those files, unfortunately they were unreadable binary codes with readable English due to not using the correct encoding UTF-8. I actually did my "homework" and found a script that could be used with your masterpiece code (somehow) so that the imported text is stored and displayed properly. Can you generously have a look at it and apply your expert modifications? here is the UTF-8 code:

[COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#303336][FONT=inherit] OutPutUTF8[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#101094][FONT=inherit]ByVal[/FONT][/COLOR][COLOR=#303336][FONT=inherit] txt [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] fName [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]String[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR]<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">[COLOR=#303336][FONT=inherit]    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] OutST [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Object[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] txtST [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Object[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] e
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Set[/FONT][/COLOR][COLOR=#303336][FONT=inherit] OutST [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] CreateObject[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"ADODB.Stream"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit] OutST
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Type [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] adTypeText
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Charset [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"UTF-8"[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]LineSeparator [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] adLF
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Open
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]WriteText txt[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]0[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Position [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]3[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Set[/FONT][/COLOR][COLOR=#303336][FONT=inherit] txtST [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] CreateObject[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"ADODB.Stream"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit] txtST
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Type [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] adTypeBinary
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Open
        OutST[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]CopyTo txtST
        [/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]SaveToFile fName[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]2[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    [/FONT][/COLOR][COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]With[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
    txtST[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Close
    OutST[/FONT][/COLOR][COLOR=#303336][FONT=inherit].[/FONT][/COLOR][COLOR=#303336][FONT=inherit]Close [/FONT][/COLOR]</code>[COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR]

Thank you very much indeed.

T.

 

[John_w]

I think that code is saving a text string as UTF-8 characters in a file, not reading a UTF-8 file, so wouldn't really help with your situation.

Try replacing the Import_Text_File function with:

Private Function Import_Text_File(fileName As String, destinationCell As Range) As Long
    With destinationCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & fileName, Destination:=destinationCell)
        .Name = "text file"
        .TextFilePlatform = 65001 'Unicode (UTF-8)
        .RefreshStyle = xlInsertDeleteCells
        .Refresh BackgroundQuery:=False
        Import_Text_File = .ResultRange.Rows.Count
        .Delete
    End With
End Function

If that doesn't import the data correctly, try manually importing a file with the Text Import Wizard (Data tab -> From Text) and if it works record a macro which can be incorporated into my code. If not, I would need to see an example of the file with English and Arabic characters - upload the file to a file sharing site if you want to and I'll try to modify my code.

 

[tenda]

It did really work John.
Thank you very very much. You do have such invaluable input to this world; I hope this will last for a long time ..
All the best ..

T.