VBA遍历指定目录下的excel及电子表名称

Sub GetSheetName()
    Dim Path As String
    Dim File As String
    Dim WB As Workbook
    Dim sht As Worksheet
    Dim arr() As String
    Dim narr() As String
    
        Application.ScreenUpdating = False 
        Path = ThisWorkbook.Path & "/" 
        File = Dir(Path & "*.xlsx") 
        
        i = 0
        Do While File <> ""
            
            Set Exceldata = CreateObject("Excel.Application")
            Set WB = Exceldata.Workbooks.Open(Path & File) 
            For Each sht In WB.Sheets
                ReDim Preserve arr(i)
                arr(i) = sht.Name
                i = i + 1
                ReDim Preserve narr(n)
                narr(n) = File
                n = n + 1
            Next
            File = Dir '找寻下一个excel文件
            
        Loop
        MsgBox i
        a = UBound(arr)
        b = UBound(narr)
        For j = 0 To a
        
            MsgBox arr(j)
            Cells(j + 1, 1) = CStr(arr(j))
          
        Next
        
        For k = 0 To b
            Cells(k + 1, 2) = CStr(narr(k))
        Next
        Application.ScreenUpdating = True 
End Sub