【備忘録】マクロと同じフォルダにあるExcelファイルを開いて、データ数を取得し、マクロのシートに転記する。

マクロと同じフォルダにあるExcelファイルを開いて、データ数を取得し、マクロのシートに転記する。
・B列に連番、C列にデータが入力され、最終行に合計が記載されている
・合計行は転記しない

Sub 集計()
    
    Dim Path As String
    'このマクロのあるフォルダ
    Path = ThisWorkbook.Path
    
    Dim buf As String
    Dim ext As String
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim fileName As String
    Dim wb As Workbook
    Dim ab As Workbook '開いたファイル
    Dim ws As Worksheet '開いたファイルの対象シート
    Dim lRow As Long '対象シートの最終行
    Dim ms As Worksheet '作業シート
    
    Dim msLCnt As Long '作業シート行数
    msLCnt = 1
    
    '作業シートを指定
    Set ms = ThisWorkbook.Worksheets("集計結果")
    
    'フォルダにある全てのファイルを取得
    buf = Dir(Path & "\*.*")
    Do While buf <> ""
        'フルパス
        fileName = Path & "\" & buf
        
        '拡張子取得
        ext = fso.GetExtensionName(fileName)
        
        '対象がExcelファイルだったら処理
        If ext = "xlsx" Or ext = "xls" Or ext = "XLSX" Or ext = "XLS" Then
        For Each wb In Workbooks
            If wb.Name = buf Then
                MsgBox buf & vbCrLf & "はすでに開いています", vbExclamation
                Exit Sub
            End If
        Next wb
        '対象ファイルを開く
        Set ab = Workbooks.Open(fileName)
        '対象シートの指定
        Set ws = ab.Worksheets(1)
        
        'B列最終行取得
        lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row
        
        'メインシートに書き込み
        ms.Cells(msLCnt, 1).Value = buf 'ファイル名
        ms.Cells(msLCnt, 2).Value = ws.Cells(lRow-1, 2).Value '最終行-1の値を設定
        
        '対象ファイル閉じる
        ab.Close
        
        '作業シート行数カウントアップ
        msLCnt = msLCnt + 1
        
        End If
        buf = Dir()
        
    Loop
    
    MsgBox "完了しました"
      
End Sub