フォルダの中にあるexcelファイルを再帰的に処理したい

サンプルです。

COMオブジェクトを使わずExcelのネイティブ機能で攻めてみました。

Option Explicit
Option Base 1

Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
    (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long

' 起点となるフォルダ名
Const rootFolder As String = "c:\temp\"

Sub MakeSum()

    Dim summaryFileName As String
    Dim summaryBook As Workbook
    Dim summarySheet As Worksheet
    Dim szDesktopPath As String
    
    Application.ScreenUpdating = False
    
    Set summaryBook = Workbooks.Add
    Set summarySheet = summaryBook.Worksheets(1)
    
    Call RecursiveSum(summarySheet, 1, rootFolder)
    With summarySheet
        .Range(.Columns(1), .Columns(2)).AutoFit
    End With

    ' デスクトップフォルダの取得
    szDesktopPath = String$(260, " ")
    If SHGetSpecialFolderPath(0, szDesktopPath, 0, 0) <> 0 Then
        szDesktopPath = Left$(szDesktopPath, InStr(szDesktopPath, vbNullChar) - 1) & "\"
    Else
        szDesktopPath = rootFolder
    End If

    ' 保存
    summaryFileName = szDesktopPath & "summary.xls"
    If Dir(summaryFileName) <> "" Then
        If MsgBox(summaryFileName & "は既に存在します。上書きしますか？", vbYesNo) = vbNo Then
            summaryBook.Close False
            Exit Sub
        End If
        Kill summaryFileName
    End If
    summaryBook.SaveAs summaryFileName
    summaryBook.Close False

    Application.ScreenUpdating = True

End Sub

' フォルダ内のXLSファイルの処理とサブフォルダの再帰呼出し
Function RecursiveSum(ByRef summarySheet As Worksheet, ByVal r As Long, ByVal baseFolder As String) As Long

    Dim i As Long, m As Long
    Dim n As Long
    Dim xlsFilePath As String
    Dim subFolders() As String
    
    n = 0

    ' フォルダ内のXLSファイルをリストアップ
    xlsFilePath = Dir(baseFolder & "*.xls", vbNormal)
    Do While xlsFilePath <> "" And xlsFilePath <> ThisWorkbook.Name
        summarySheet.Cells(r + n, 1).Value = baseFolder & xlsFilePath
        summarySheet.Cells(r + n, 2).Value = GetSum(baseFolder & xlsFilePath)
        n = n + 1
        xlsFilePath = Dir()
    Loop
    
    ' フォルダ内のサブフォルダをリストアップ
    m = 0
    xlsFilePath = Dir(baseFolder, vbDirectory)
    Do While xlsFilePath <> ""
        If Left$(xlsFilePath, 1) <> "." Then
            If GetAttr(baseFolder & xlsFilePath) And vbDirectory Then
                m = m + 1
                ReDim Preserve subFolders(m)
                subFolders(m) = baseFolder & xlsFilePath & "\"
            End If
        End If
        xlsFilePath = Dir()
    Loop
    
    ' 各サブフォルダを再帰的に呼出し
    For i = 1 To m
        n = n + RecursiveSum(summarySheet, r + n, subFolders(i))
    Next i
    
    ' 処理したファイル数を返す
    RecursiveSum = n

End Function

' ファイルを開いてA1:A10の合計を得る
Function GetSum(ByVal xlsFilePath As String) As Variant

    With Workbooks.Open(xlsFilePath, 0, True)
        GetSum = WorksheetFunction.Sum(.Worksheets(1).Range("A1:A10"))
        .Close False
    End With

End Function

URLはダミーです。

http://q.hatena.ne.jp/1196326344