Walking Through Many Subdirectories, Many Workbooks, Many Worksheets

**scm24** · 09-15-2009, 05:28 PM

Hello, I need to copy a specific sheet (CONSTANT gPA) from multiple workbooks in multiple subdirectories and paste (special) that sheet to the workbook where my code is located (which is at the root, C:\2010 Budget\).

The code below walks through these subdirectories well enough, but it does not "Open" any of the workbooks. Here is the line/code for opening the workbook:

Code:

Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

To give more context here is a larger code snippet:

Code:

For i = 1 To 50
        If FileOrDirExists("C:\2010 BUDGET\" & stateHold(i) & Application.PathSeparator) Then
            With Application.FileSearch
                .NewSearch
                .LookIn = "C:\2010 BUDGET\" & stateHold(i) & Application.PathSeparator
                .FileType = msoFileTypeExcelWorkbooks
                .Filename = "*.xls"
                If .Execute() > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.Count ' Loop through all.
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                            If IsNumeric(Mid(wbResults.Name, 3, 4)) Then
                                For Each wks In Worksheets
                                    Select Case wks.Name
                                    Case gPA
                                        wks.Unprotect
                                        wks.Copy
                                        Workbooks("2010 BUDGET TEMPLATE-ACCT-TEST.xls").Activate
                                        Sheets.Add.Name = wbResults.Name & " - GPA"
                                        Sheets(wbResults.Name & " - GPA").Select
                                        Selection.PasteSpecial Paste:=xlValues
                                        Application.CutCopyMode = False
                                    End Select
                                Next wks
                            End If
                            Workbooks(wbResults.Name).Activate
                            wbResults.Close SaveChanges:=True
                    Next lCount
                End If
            End With
        End If
    Next i

I am using Excel '07 on Vista, and I have tried to run this macro as both a '07 and '03 xls. Where do you think I am going wrong here?

Thanks in advance.

**Rick_Stanich** · 09-15-2009, 05:32 PM

You stated you are also working in Excel 2007, how many files use the 2007 suffix such as ".xlsx" or ".xlxm"?

Your code wont find those.

Code:

Filename = "*.xls"

**scm24** · 09-15-2009, 05:51 PM

are all .XLS...should've mentioned that initially...

Thanks!

**shg** · 09-15-2009, 05:58 PM

FileSearch is not supported in Excel 2007.

If you're doing it in 2003, you should be able to debug to see how many files are returned by the search

**Leith Ross** · 09-15-2009, 07:53 PM

Hello scm24,

This macro uses the File System Object which is supported in Excel 2003 and 2007. It checks for either ".xls" or ".xlsx" file types.

Code:

Sub CopyFiles()

  Dim DstWks As Worksheet
  Dim File As Object
  Dim Folder As Object
  Dim FolderPath As String
  Dim FSO As Object
  Dim SubFolders As Object
    
    FolderPath = "C:\2010 BUDGET"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
      Set SubFolders = FSO.GetFolder(FolderPath).SubFolders
        For Each Folder In SubFolders
          For Each File In Folder.Files
            If File Like "*.xls" Or File Like "*.xlsx" Then
               Set wbResults = Workbooks.Open(Filename:=File.Path & "\" & File.Name, UpdateLinkes:=False)
               If IsNumeric(Mid(wbResults.Name, 3, 4)) Then
                  With Workbooks("2010 BUDGET TEMPLATE-ACCT-TEST.xls")
                    Set DstWks = .Worksheets(.Worksheets.Count)
                      With wbResults.Worksheets("gPA")
                        .Unprotect
                          .Copy After:=DstWks
                        .Protect
                      End With
                    DstWks.Name = wbResults.Name & " - GPA"
                  End With
               End If
               wbResults.Close SaveChanges:=True
            End If
          Next File
        Next Folder
        
    Set FSO = Nothing
    
End Sub