Extracting excel files only from 3rd subfolder and only from certain folders

[nik_galla]

Hi,

I am new to VBA and hope someone can help me? The macro should runs through to the third level subfolder from a main folder and extract the excel files from all the folders EXCEPT folders with a specific name.

So for example Main location: H:\Mijn documenten\Test add folders--Subfolder 1---subfolder 1.1 (don't copy files from folders "correspondence" and "old"----excel file (xls*).

I would like to paste this in a new folder.

Would really appreciate the help. Thanks in advance!

[werafa]

found this with a search for "excel vba loop through subfolders"
You will first need to find each subfolder path, then test each name found to see if it is valid

http://stackoverflow.com/questions/22645347/loop-through-all-subfolders-using-vba

[nik_galla]

Thanks! I found something in the meantime but I don't get any visible results. Any ideas?:
Sub LoopFolders()
Dim FSO As Object
Dim fld As Object
Dim sfl As Object
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
' Set the parent folder
Set fld = FSO.GetFolder("H:\Mijn documenten\Test add folders")
' Loop through its subfolders
For Each sfl In fld.Subfolders
Select Case sfl.Name
Case "Output"
' Skip this folder
Case Else
' Process this folder
ProcessFolder sfl
End Select
Next sfl
Application.ScreenUpdating = True
End Sub

Sub ProcessFolder(fld As Object)
Dim sfl As Object
Dim sf2 As Object
Dim fil As Object
Dim wsh As Worksheet
Dim wbk As Workbook
Dim r As Long
Set wsh = ThisWorkbook.Worksheets("Blad1")
' Loop through the subfolders of the folder
For Each sfl In fld.Subfolders
' Go one level deeper
For Each sf2 In sfl.Subfolders
' Loop through the files in this subfolder
For Each fil In sfl.Files
' Only process .xls* files
If LCase(Right(fil.Name, 5)) = ".xlsb*" Then
' Open the workbook
Set wbk = Workbooks.Open(fil.Path)
' Get last used row in target sheet
r = wsh.Cells.Find(What:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
' Copy data to the workbook running the macro
wbk.Worksheets(1).Range("A1:AA1000").Copy _
Destination:=wsh.Cells(r + 1, 1)
' Close the workbook
wbk.Close SaveChanges:=False
End If
Next fil
Next sf2
Next sfl
End Sub

[nik_galla]

Also, I need to somewhere add-in the folder names which shouldn't be looked in...

Thanks for the help.

[werafa]

Set the names to avoid in a string array

then do something like: (and use the VBA code tags when you paste code)


for myNum = 0 to ubound(myString)
if mystring(mynum) = myfolder then set myflag = true 'ID that you found a name match
next mynum

write this as a function, and return the myFlag as boolean to say process or skip

--------------

re your code, does the first sub work?
you can use the 'debug.print' command to write variables to the immediate window for checking

are your files actually xlsb? actually, this line seeks to match a 5 character string with a 5+ character string - it will never be true.