VBA - MS Excel, modify code to include files in sub-folders as well

[vancouverjackluo]

I have the following VBA macro, and I am using it to create a log by extracting certain values from a list of excel files in a particular.
However, instead of just the files in <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: pre-wrap; background-color: rgb(238, 238, 238);">G:\INSPECTION REPORTS\</code>, I would like it to work for ALL files in the sub-folders as well. For example, files in <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: pre-wrap; background-color: rgb(238, 238, 238);">G:\INSPECTION REPORTS\AAA</code> and <code style="margin: 0px; padding: 1px 5px; border: 0px; font-size: 13px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: pre-wrap; background-color: rgb(238, 238, 238);">G:\INSPECTION REPORTS\BBB</code>, .....etc. How can I modify the following code to do so?


<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">Sub ABC()
Dim sPath As String, sName As String
Dim bk As Workbook, sh As Worksheet
Dim rw As Long

Set sh = ActiveSheet

rw = 2 ' which row to write to in the activesheet
sPath = "G:\INSPECTION REPORTS\" ' Path for file location
sName = Dir(sPath & "*.xlsx") ' for xl2010 & "*.xlsx?"
Do While sName <> "" 'Loop until filename is blank
Set bk = Workbooks.Open(sPath & sName)
sh.Cells(rw, "A") = bk.Name
sh.Cells(rw, "B") = bk.Worksheets(1).Range("B8")
sh.Cells(rw, "C") = bk.Worksheets(1).Range("B12")


rw = rw + 1
bk.Close SaveChanges:=False
sName = Dir()
Loop

End Sub</code>

 

[tonyyy]

There's a pretty good tutorial titled...
[h=2]Excel VBA, Find and List All Files in a Directory and its Subdirectories[/h]Cheers,

tonyyy