View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Tendresse Tendresse is offline
external usenet poster
 
Posts: 117
Default Loop through folders

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