【VBA】サンプル（Excelを開いて値を集計する）

Sheet1にコードを記載

Private Sub CommandButton1_Click()
    'エラーメッセージ
    Dim colErrMsg As New Collection
    
    '「メイン」シート
    Dim sheetMain As Worksheet
    Set sheetMain = ThisWorkbook.Sheets("メイン")
    
    '「集計結果」シート
    Dim sheetResult As Worksheet
    Set sheetResult = ThisWorkbook.Sheets("集計結果")

    'ディレクトリのパスを格納
    Dim colDir As New Collection
    
    'ファイルのパスを格納
    Dim colFile As New Collection
    
    '集計結果を格納
    Dim colResult As New Collection
    
    '一時的な値を格納
    Dim tmp As Variant
        
    '画面更新の非表示
    Application.ScreenUpdating = False

    '▼「集計結果」シートを初期化
    '2行目～最終行までクリア
    sheetResult.Rows(2 & ":" & Rows.Count).ClearContents

    '▼一覧のパスを取得
    For Each tmp In sheetMain.Range("inputDirList")
        If tmp <> "" Then
            colDir.Add tmp.Value
        End If
    Next

    '▼入力件数のチェック
    If colDir.Count = 0 Then
        '0件の場合エラー
        colErrMsg.Add ("対象のディレクトリを入力してください")
        GoTo ErrorEnd
    End If
    
    '▼ディレクトリ存在チェック＋ファイルのパスを取得
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim f As Variant
    
    For Each tmp In colDir
        If dir(tmp, vbDirectory) = "" Then
            colErrMsg.Add ("ディレクトリが存在しません：" & tmp)
        Else
            For Each f In fso.GetFolder(tmp).Files
                colFile.Add (f.Path)
            Next
        End If
    Next
    If colErrMsg.Count <> 0 Then
        GoTo ErrorEnd
    End If
    
    '▼値を集計する
    Dim resultValue As New result
    Dim targetBook As Workbook
    
    '読み取り専用推奨メッセージを表示しない
    Application.DisplayAlerts = False
    
    For Each tmp In colFile
        '拡張子が"xlsx"のみ対象とする
        If fso.GetExtensionName(tmp) = "xlsx" Then
            'ブックを開く
            Set targetBook = Workbooks.Open(tmp)
            'ディレクトリを格納
            resultValue.dir = fso.GetParentFolderName(tmp)
            '名前を格納
            resultValue.name = targetBook.Sheets(1).Range("B2")
            colResult.Add resultValue
            Set resultValue = Nothing
            'ブックを閉じる
            targetBook.Close savechanges:=False
        End If
        
    Next
    
    '▼結果を出力する
    Dim i As Long
    i = 2
    For Each tmp In colResult
        sheetResult.Cells(i, 2).Value = tmp.dir
        sheetResult.Cells(i, 3).Value = tmp.name
        i = i + 1
    Next
    
    '▼「集計結果」シートを表示する
    sheetResult.Activate
    
    '▼処理終了メッセージを表示する
    MsgBox "集計処理が完了しました｡", vbInformation
    
Exit Sub

'■エラー時の処理
ErrorEnd:
    Dim errMsg As String
    
    For Each tmp In colErrMsg
        If errMsg <> "" Then
            'エラーメッセージの改行
            errMsg = errMsg & vbCrLf
        End If
        errMsg = errMsg + tmp
    Next

    MsgBox errMsg, vbCritical
    
End Sub

クラスを作成してコードを記載
クラス名は「Result」とする

Public dir As String
Public name As String