Thank you. I understand the point and click method but this will not
bring in all the muti files that are sat below my file structure.
I do need to write the code but I would not know where to start as my
second layer down change names as they are named the date the file was
created and a similar issue with the txt files themselves as they are
named date and time of file being written, plus a unique customer
identifier. I've seen code that uses wildcards but not at a 3 layer
approach.
I do have something above these files currently that brings them into an
excel file but with the amount of data I have this is a very timely
process and I still have to txt to columns after I've brought it in. I
would like my process to be quicker going forward.
Current Excel VBA code
ub Button1_Click()
'
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String
Application.ScreenUpdating = False
Dim newWS As Worksheet
Set newWS = Sheets.Add(before:=Sheets(1))
Set fso = CreateObject("scripting.FileSystemObject") ' late binding
'Set fso = New FileSystemObject 'or use early binding (also replace
Object types)
Set fldStart = fso.GetFolder("FILEPATH") ' <-- use your FileDialog
code here
Mask = "*.txt"
'Debug.Print fldStart.Path & "\"
ListFiles fldStart, Mask
For Each fld In fldStart.SubFolders
ListFiles fld, Mask
ListFolders fld, Mask
Next
Dim myWB As Workbook, WB As Workbook
Set myWB = ThisWorkbook
Dim L As Long, t As Long, i As Long
L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
t = 1
For i = 1 To L
Workbooks.OpenText Filename:=myWB.Sheets(1).Cells(i, 1).Value,
DataType:=xlDelimited, Tab:=True
Set WB = ActiveWorkbook
WB.Sheets(1).UsedRange.Copy newWS.Cells(t, 2)
t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
WB.Close False
Next
myWB.Sheets(1).Columns(1).Delete
Application.ScreenUpdating = True
End Sub
Sub ListFolders(fldStart As Object, Mask As String)
Dim fld As Object 'Folder
For Each fld In fldStart.SubFolders
'Debug.Print fld.Path & "\"
ListFiles fld, Mask
ListFolders fld, Mask
Next
End Sub
##- Please type your reply above this line. Simple formatting, no
