Macro to Import Multiple TXT Files into workbook - User to select files/directory

Spent most of today looking but just can't find the answer, hoping someone smarter than me here can help.

I have uploaded the XLSM file I am working on and an example TXT file.

What I am trying to do is import a series of these Comma Delimited TXT files from our scanners into a excel worksheet.
I need the user to be able to select the files or at least the directly where the TXT files located as it will very depending on who is using the workbook.

After they have selected them I want it to add all the txt file data stacked one on top of each other to the Worksheet called Data.
I want the data to go in starting from Row 2 so that the header data stays intact

FYI
(also sheets are protected but with no password)

Any help is greatly appreciated.

Thanks I will try it.
I did come accross that code but didn't know how to prompt for a directory.
Also that code does not put the data into the worksheet DATA as I mentioned in my first post.
I don't want it to import the files and create a new worksheet.
I want to import them and place them in the DATA worksheet that is already made.

Can this be done.

thanks.

Hi.
Thanks for your help again.

It is very close to working.
However I have an issue importing the TXT file.
It is not seeing it as a comma deliminated file and as such is just putting the data into one cell.
Can you have a look at the below code and let me know what is missing.
Thanks again.

Sub ImportTXTsWithReference()

Dim wbTXT   As Workbook
Dim wsMstr  As Worksheet
Set wsMstr = ActiveSheet
If MsgBox("Inport and clear the existing Scanner Data?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.Range("DataTable").Clear

Dim fPath   As String:      fPath = BrowseForFolderShell    'path to TXT files, include the final \
Dim fTXT    As String
   

Application.ScreenUpdating = False  'speed up macro

fTXT = Dir(fPath & "*.txt")         'start the TXT file listing

    Do While Len(fTXT) > 0
      'open a CSV file
        Set wbTXT = Workbooks.Open(fPath & fTXT)
        
      'insert col A and add CSV name
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
      'copy date into master sheet and close source file
        ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
        wbTXT.Close False
      'ready next CSV
        fTXT = Dir
    Loop
 
Application.ScreenUpdating = True
End Sub

Function BrowseForFolderShell() As String
Dim objShell As Object, objFolder As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0)      'SpecFolders.CSIDL_FAVORITES

BrowseForFolderShell = CStr(objFolder.items.Item.Path & Application.PathSeparator)

End Function

I put it in but now it is not importing anyting.... I am going nuts.
What did I miss.

Sub ImportTXTsWithReference()
'Author:    Jerry Beaucaire
'Date:      10/16/2010
'Summary:   Import all CSV files from a folder into a single sheet
'           adding a field in column A listing the CSV filenames


Dim wbTXT   As Workbook
Dim wsMstr  As Worksheet
Set wsMstr = ActiveSheet
If MsgBox("Inport and clear the existing Scanner Data?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.Range("DataTable").Clear

Dim fPath   As String:      fPath = BrowseForFolderShell    'path to TXT files, include the final \
Dim fTXT    As String
   

Application.ScreenUpdating = True  'speed up macro

fTXT = Dir(fPath & "*.csv")        'start the TXT file listing
        
Do While Len(fTXT) > 0
      'temporarily rename the file
        Name fPath & fTXT As fPath & Replace(fTXT, ".txt", ".csv")

      'open a CSV file
        Set wbTXT = Workbooks.Open(fPath & fTXT)
      'insert col A and add CSV name
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
      'copy date into master sheet and close source file
        ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
        wbTXT.Close False

      'put the filename back
        Name fPath & fTXT As fPath & Replace(fTXT, ".csv", ".txt")

      'ready next CSV
        fTXT = Dir
    Loop
    
Application.ScreenUpdating = True
End Sub

Function BrowseForFolderShell() As String
Dim objShell As Object, objFolder As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0)      'SpecFolders.CSIDL_FAVORITES

BrowseForFolderShell = CStr(objFolder.items.Item.Path & Application.PathSeparator)

End Function