Include Imported file name when importing data from txt file.

[Stigmata101]

Hi guys

I have the following code that is working well, however, I need to include the file name for each row of the imported data set.

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row

            ' IMPORT DATA FROM TEXT FILE
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = True
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .TextFileColumnDataTypes = Array(4, 1, 1, 2)
                '1 = xlGeneralFormat General
                '2 = xlTextFormat    Text
                '3 = xlMDYFormat     MDY date
                '4 = xlDMYFormat     DMY date
                '9 = xlSkipColumn    Skip column
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

This code will import data from multiple files, delimit and format.
What I need is to have each row reflect where the data comes from, something like; (File Path: C:\Users\Desktop\My Work\Scanning\IP_LF_RUSHAAD_01.TXT)

Date Scanned	Time	Ref	Label	Import File
27 01 2021​	05:57:11​	1​	IPLF	IP_LF_RUSHAAD_01.TXT
27 01 2021​	05:59:59​	1​	SPL34 PIN1	IP_LF_RUSHAAD_01.TXT
27 01 2021​	06:00:01​	1​	1019007913	IP_LF_RUSHAAD_01.TXT
27 01 2021​	06:00:01​	1​	1018987840	IP_LF_RUSHAAD_01.TXT
27 01 2021​	06:00:02​	1​	1018987840	IP_LF_RUSHAAD_02.TXT
27 01 2021​	06:00:03​	1​	1019007913	IP_LF_RUSHAAD_02.TXT
27 01 2021​	06:00:18​	3​	1019004195	IP_LF_RUSHAAD_02.TXT
27 01 2021​	06:00:19​	3​	1019000320	IP_LF_RUSHAAD_02.TXT

 

[John_w]

Try this modified macro.

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant
    Dim importRow As Long

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")
                  
    If VarType(txtfilesToOpen) = vbBoolean Then Exit Sub  'Cancel clicked

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importRow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row

            ' IMPORT DATA FROM TEXT FILE
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, Destination:=.Cells(importRow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = True
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .TextFileColumnDataTypes = Array(4, 1, 1, 2)
                '1 = xlGeneralFormat General
                '2 = xlTextFormat    Text
                '3 = xlMDYFormat     MDY date
                '4 = xlDMYFormat     DMY date
                '9 = xlSkipColumn    Skip column
                .Refresh BackgroundQuery:=False
                .ResultRange.Item(1, .ResultRange.Columns.Count + 1).Resize(.ResultRange.Rows.Count).Value = txtfile
                .Delete
            End With

        Next txtfile

'        For Each qt In .QueryTables
'            qt.Delete
'        Next qt

    End With

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

 

[Stigmata101]

Hey John

That works perfectly, thanks a million.

As a cherry on top, if I just want to display the file name and not the complete path, what would I need to change?

Stig

 

[John_w]

                .ResultRange.Item(1, .ResultRange.Columns.Count + 1).Resize(.ResultRange.Rows.Count).Value = Mid(txtfile, InStrRev(txtfile, "\") + 1)

 

[Stigmata101]

Thanks John, that is perfect now.

Appreciate the help
Stig