サブフォルダのCSVファイルを読み込むVBA

chatgptに書いてもらいました!
タイトル通りです。
VBAファイルと同じところに「ホゲ」フォルダが在り、その中のサブフォルダ内にある損益と名前がついたCSVファイルの中身を、VBAファイル内シートに書き出します。

Sub ImportProfitLossCSV()
    Dim subFolder As String, filePath As String
    Dim fso As Object, mainFldr As Object, subFldr As Object, file As Object
    Dim lastRow As Long
    
    ' メインフォルダのパス
    Dim mainFolder As String
    mainFolder = ThisWorkbook.Path & "\ホゲ"
    
    ' シートを指定
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("CSV読込シート")
    ws.Cells.Clear ' 既存のデータをクリア
    
    ' ファイルシステムオブジェクトを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set mainFldr = fso.GetFolder(mainFolder)
    
    ' メインフォルダ内のサブフォルダをループ
    For Each subFldr In mainFldr.SubFolders
        subFolder = subFldr.Path
        
        ' サブフォルダ内のファイルをループ
        For Each file In subFldr.Files
            If LCase(file.Name) Like "*損益*.csv" Then
                filePath = file.Path
                
                ' 最終行を取得
                lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
                
                ' CSVデータをインポート
                With ws.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=ws.Cells(lastRow, 1))
                    'このwith内は株式会社SAMURAIさまのHPを参考に(というかそのまま)
                    '記入させていただいております。
                        .TextFilePlatform = 932          ' 文字コードを指定。この場合はShift_JIS ・65001:UTF-8
                        .TextFileParseType = xlDelimited ' 区切り文字の形式
                        .TextFileCommaDelimiter = True   ' カンマ区切り
                        .RefreshStyle = xlOverwriteCells ' セルに書き込む方式
                        .Refresh
                End With
            End If
        Next file
    Next subFldr
    
    ' オブジェクトを解放
    Set fso = Nothing
    Set mainFldr = Nothing
    
    MsgBox "全てのCSVを読み込みました", vbInformation
End Sub

 

記事は以上になります。ここまでご覧頂き、ありがとうございました。

コード内参考サイトさま:【ExcelVBA入門】QueryTablesメソッドで高速にファイルを読み込む方法

おすすめの記事