Sub Get_Customer_Data()
Const TOP_FLDR As String = "C:\Users\Richard\Documents\SpreadSheets\MrExcel\Parent" 'amend this to be the folder than contains all the others
Dim strTxt As String
Dim fso As Object, fl_top As Object, fl_Int As Object, fl_Bot As Object, f As Object
Dim ws As Worksheet
Dim lngNxtRw As Long
Dim i As Long, j As Long
Dim vArrParent, vArrChild
Set fso = CreateObject("Scripting.FileSystemObject")
Set fltop = fso.GetFolder(TOP_FLDR)
Set ws = Worksheets.Add
With ws
With .Range("A1:G1")
.Value = Array("Customer Name", "Region Name", "Link to source file", "First Column Value", "Year", "Month", "Value")
.Font.Bold = True
End With
lngNxtRw = 2
For Each fl_Int In fltop.SubFolders 'customer folder
For Each fl_Bot In fl_Int.SubFolders 'region folders
For Each f In fl_Bot.Files 'individual files
strTxt = f.OpenAsTextStream(1).ReadAll 'get all the data
strTxt = Replace(strTxt, vbCrLf, vbLf) 'ensure consistent delimiters to vbLf
vArrParent = Split(strTxt, vbLf) 'store each line of data
For i = 0 To UBound(vArrParent)
.Cells(lngNxtRw, 1) = fl_Int.Name
.Cells(lngNxtRw, 2) = fl_Bot.Name
.Hyperlinks.Add anchor:=.Cells(lngNxtRw, 3), Address:=f.Path
vArrChild = Split(vArrParent(i), " ")
.Cells(lngNxtRw, 4).Resize(, 4) = vArrChild
lngNxtRw = lngNxtRw + 1
Next i
Erase vArrChild
Erase vArrParent
strTxt = vbNullString
Next f
Next fl_Bot
Next fl_Int
End With
End Sub
