如何在vba中的多个目录和子目录中获取多个xls文件的值？

Question

VBA代码每次都停止执行，就像我按下Ctrl-break一样，我没有。我想从不同目录和子目录中的不同xls文件中获取一些值。我尝试将一些代码组合在一起，但显然它在某处犯了错误。

Private Function GetValue(path, file, sheet, ref)
'   Retrieves a value from a closed workbook
Dim arg As String
'   Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
    GetValue = "File Not Found"
    Exit Function
End If
'   Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
'   Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function

Sub TraversePath(path As String)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection
Dim Val As Variant
Dim b As Single
Dim c As Single
Dim d As Single
Dim Description As Variant
Dim Sheet As Variant
ReDim Sheet(0 To 2)

b = 1
Sheet(0) = "B7"
Sheet(1) = "C5"

currentPath = Dir(path, vbDirectory)

'Explore current directory
Do Until currentPath = vbNullString
    Debug.Print currentPath
    If Left(currentPath, 1) <> "." And _
        (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
        dirCollection.Add currentPath
    End If
    currentPath = Dir()
    If InStr(currentPath, "xls") > 0 Then
'            Sheets("Sheet1").Activate
        p = path
        f = currentPath
        s = "Sheet1"
        a = Sheet(0)
        Description = GetValue(p, f, s, a)
        For c = 0 To 6
            Val = GetValue(p, f, s, a)
            Sheets("Sheet1").Cells((1 + b), (1 + c)) = Val
        Next c
    Else
    End If
Loop

'Explore subsequent directories
For Each directory In dirCollection
    Debug.Print "---SubDirectory: " & directory & "---"
    TraversePath path & directory & "\"
Next directory
End Sub

Sub Test()
TraversePath "C:\x\"
End Sub