Loop through folders

[Tendresse]

I need some help with the following code, please.
I have a big number of Excel workbooks saved as follows:

H\Drive: Main Folder (containing the following subfolders):
SubFolder 1
SubFolder 2
etc
SubFolder 50

Inside each one from SubFolder 2 through 50, there are 10 workbooks. The
exception is SubFolder 1 that has 100 workbooks.

What i want to do is to go through SubFolders 2 to 50 and make a copy of
only 3 workbooks in each of these SubFolders to a different destination. The
following code is very close to what i want to achieve, however i need to
adjust 2 things:

First: i want to add in there something to 'Skip' SubFolder 1 (i don't need
to make a copy of any of the workbooks in there)

Second: how can i make the copy of the workbooks i need without having to
open them?

I'm using Excel 2003.
Any help is much appreciated.
Tendresse
_________________
Sub CreateCopy()

Dim MyBook As Workbook
Dim MyFilePath As String
Dim i As Integer

' Search for the Excel files in the Main Folder

With Application.FileSearch
.NewSearch
.LookIn = "H:\Main Folder"
.SearchSubFolders = True ' how do i say here 'except the first one'
.FileType = msoFileTypeExcelWorkbooks

' when files are found: copy and paste them in a different destination

If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set MyBook = Workbooks.Open(.FoundFiles(i), , True)

With MyBook
If .Name Like "*Paris*" Then
MyFilePath = "H:\Paris\"
.SaveCopyAs MyFilePath & .Name

ElseIf .Name Like "*London*" Then
MyFilePath = "H:\London\"
.SaveCopyAs MyFilePath & .Name

ElseIf .Name Like "*Rome*" Then
MyFilePath = "H:\Rome\"
.SaveCopyAs MyFilePath & .Name

End If

.Close (False)

End With
Next i
End If
End With
MsgBox "done"

End Sub

 

[Rick Rothstein \(MVP - VB\)]

Give the code after my signature a try. It is a modification of your
originally posted code where I removed the need to open the file. The folder
name to skip needs to be set in the Const statement I added just after the
Dim statements. I also added a couple of comments to help you figure out
what I did. If you have any questions about my code, feel free to ask.

Rick

'******************** START OF CODE ********************
Sub CreateCopy()
Dim i As Integer
Dim MyBook As Workbook
Dim FileName As String
Dim LastFolder As String
Dim MyFilePath As String
Dim PathParts() As String
Const FolderToSkip As String = "SubFolder 1"
With Application.FileSearch
.NewSearch
.LookIn = "H:\Main Folder"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
' Break the path/filename up into parts
PathParts = Split(.FoundFiles(i), "\")
FileName = PathParts(UBound(PathParts))
LastFolder = PathParts(UBound(PathParts) - 1)
' This statement will skip over files belonging to the
' folder name declared in the FolderToSkip constant
If StrComp(LastFolder, FolderToSkip, vbTextCompare) <> 0 Then
' Determine which folder
If FileName Like "*Paris*" Then
MyFilePath = "H:\Paris\"
ElseIf FileName Like "*London*" Then
MyFilePath = "H:\London\"
ElseIf FileName Like "*Rome*" Then
MyFilePath = "H:\Rome\"
End If
' If file is in one of the above folders, copy it
If Len(MyFilePath) > 0 Then
FileCopy .FoundFiles(i), MyFilePath & FileName
End If
End If
Next
End If
End With
MsgBox "DONE"
End Sub
'******************** END OF CODE ********************

 

[Tendresse]

Rick,
Thank you so much for your help .. it worked like a dream ... It skipped the
first folder and didn't open any of the files that i wanted copies of.
Beauty!

I only had to adjust one minor thing as it was making copies of some files
even though their names don't contain the words 'Paris', "London' or 'Rome'.
I adjusted that part as follows and it's working very well:

If FileName Like "*Paris*" Then
MyFilePath = "H:\Paris\"

' I moved the following line here instead of it being
' in a separate IF Statement.
FileCopy .FoundFiles(i), MyFilePath & FileName

ElseIf FileName Like "*London*" Then
MyFilePath = "H:\London\"

FileCopy .FoundFiles(i), MyFilePath & FileName

ElseIf FileName Like "*Rome*" Then
MyFilePath = "H:\Rome\"

FileCopy .FoundFiles(i), MyFilePath & FileName

End If

End If
Next 'etc


Now that this code is working very well, i would like to take it one step
further. If i want to skip not only SubFolder 1, but subfolders 2 to 8 as
well. In other words, i want the code to make copies of files in folders 9 to
50 only. Being an absolute beginner, the only way i can think of is to
declare 9 constants at the beginning of the code, then adjust the body of the
code as follows

If StrComp(LastFolder, FolderToSkip1, vbTextCompare) <> 0 OR _
If StrComp(LastFolder, FolderToSkip2, vbTextCompare) <> 0 OR _
If StrComp(LastFolder, FolderToSkip3, vbTextCompare) <> 0 OR _
etc THEN etc etc

However, i feel there must be a smarter way .... because what if i wanted to
skip a large number of subfolders? can't have a Const for each one!!

The other thing i would like to learn as well please, if subfolders 1 to 8
(that i want to skip) also have other subfolders of their own, and it may be
a few levels down before you can reach the Excel workbooks, how do i skip
folders 1 to 8 and any subfolders they may contain, knowing that the number
of levels could be different in these 8 subfolders.

Now it's getting complicated ... isn't it?
Thanks again for all your help ...much appreciated ..