Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop through folders
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" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Loop through folders
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 StrComp(LastFolder, FolderToSkip, vbTextCompare) < 0 Then 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 .. "Rick Rothstein (MVP - VB)" wrote: 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" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
returning back to loop check condition without completing the loop | Excel Programming | |||
Loop thru folders | Excel Programming | |||
Loop to Filter, Name Sheets. If Blank, Exit Loop | Excel Programming | |||
List folders but not sub folders | Excel Programming | |||
loop folders macro - Sorry for duplicate posts | Excel Discussion (Misc queries) |