Sub b()
    Range("a2", "zz99").Clear
    
    'Call getFolderAndFileListFromDialogSub("c:\wk")
    Call getFolderAndFileListFromDialogSub(Range("A1"), 2)
End Sub

'メニューのツール > 参照設定を選択
'Microsoft Scripting Runtimeをチェック
Sub getFolderAndFileListFromDialogSub(folderPath As String, Optional myCount As Long = 1)

    Dim fso As New FileSystemObject, myFolder As Folder, myFile As File
    Dim pt, fn As String
    For Each myFile In fso.GetFolder(folderPath).Files
        If Right(myFile, 5) = ".xlsx" Then
            Cells(myCount, 1) = myFile.Path
            Cells(myCount, 2) = ExecuteExcel4Macro("'" & folderPath & "\[" & myFile.Name & "]Sheet1'!R1C1")
            
            myCount = myCount + 1
        End If
        
    Next
    
    For Each myFolder In fso.GetFolder(folderPath).SubFolders
    
        Call getFolderAndFileListFromDialogSub(myFolder.Path, myCount)
        
    Next

End Sub




--
Private Sub CommandButton1_Click()
    Cells.Clear
    Dim fn, pt
    fn = Dir(ThisWorkbook.Path & "\*テスト仕様書*.xls", vbNormal)
    pt = ThisWorkbook.Path & "\"
    Dim RowCnt, ColCnt As Integer
    RowCnt = 3
    Do While fn <> ""
            
        'ブック名
        Dim wb As Workbook
        Set wb = Workbooks.Open(fn, ReadOnly:=True)
        'Cells(RowCnt, 2).Value = fn
        ActiveSheet.Hyperlinks.Add Cells(RowCnt, 2), "file://" & pt & fn, , , fn
        RowCnt = RowCnt + 1
        
        'シート
        Dim ws As Worksheet
        For Each Sheet In ActiveWorkbook.Sheets
            Set ws = wb.Worksheets(Sheet.Name)
            
            'シート名
            'Cells(RowCnt, 2).Value = Sheet.Name
            ActiveSheet.Hyperlinks.Add Cells(RowCnt, 2), "file://" & pt & fn & "#" & Sheet.Name & "!a1", , , Sheet.Name
                       
            'B列を数える
            'Cells(RowCnt, 3).Formula = "=counta('" & pt & "[" & fn & "]" & Sheet.Name & "'!b3:b99)"
            Cells(RowCnt, 3).Value = WorksheetFunction.CountA(Sheets(Sheet.Name).Columns(2)) - 1
            RowCnt = RowCnt + 1
        Next
        
        wb.Close
    
        fn = Dir()
    Loop
    
End Sub


--
Sub list()
    Dim i
    
    Cells.Clear
    For i = 1 To Worksheets.Count
        Line = 4 + i
    
        ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & Line), _
            Address:="", _
            SubAddress:=Worksheets(i).Name & "!A1", _
            TextToDisplay:=Worksheets(i).Name
        
        Range("C" & Line) = Worksheets(i).Range("A1")
    Next
End Sub


--
Sub list()
    Dim i
    Dim cell1 As Range
    Dim sheetname1
    
    
    Cells.Clear
    With Range("e4")
      .Value = "内容"
      .Interior.ColorIndex = 40
      .Borders.LineStyle = xlContinuous
      .Borders.Weight = xlThin
      
    End With
    
    For i = 1 To Worksheets.Count
        Line = 4 + i
        
        Set cell1 = Range("B" & Line)
        sheetname1 = Worksheets(i).Name
        
        ActiveSheet.Hyperlinks.Add Anchor:=cell1, _
            Address:="", _
            SubAddress:="'" & sheetname1 & "'" & "!A1", _
            TextToDisplay:="'" & sheetname1
        
        'Range("C" & Line) = Worksheets(i).Range("A1")
        Range("E" & Line).Borders.LineStyle = xlContinuous
    Next
End Sub