PR
CSVファイル操作

【ExcelVBA】csvファイルを読み込む(下層フォルダ含む)

コードを紹介。コードと記事内容は追って推敲予定。

Dim fso As Object
Dim Folder As Object
Dim SUB_Folder As Object
Dim LastRow As Long
Dim folder_Path As String
Dim filePath As String
Dim file As Object
Dim retsumei() As String
Dim retsumei_2() As String
Dim data As Variant
Dim line As String
Dim i, j As Integer
Dim fileArr() As String
Dim folderArr() As String

Sub フォルダ内の全てのサブフォルダ名のリスト化()

 'フォルダダイアログでフォルダを選択する
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "フォルダを選択してください"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
        folder_Path = .SelectedItems(1)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(folder_Path)




'選択したフォルダ内の全てのファイルに対して処理を行う
For Each file In Folder.Files
    'ファイルの拡張子が.csvの場合、ファイルを開く
    If Right(file.Name, 4) = ".csv" Then
        Set file = fso.OpenTextFile(file.Path)
            
            i = Range("A1048576").End(xlUp).Row
            
            '列名を取得する(1行目(i=1)を列名とする)
            retsumei = Split(file.ReadLine, ",")
            retsumei_2 = Split(file.ReadLine, ",")
                    
            '1,2行目(A1セル始点)に列名を出力する(2シート名以降は列名無視)
            If i = 1 Then
                For j = LBound(retsumei) To UBound(retsumei)
                    Cells(1, j + 1).Value = retsumei(j)
                Next j
                For j = LBound(retsumei_2) To UBound(retsumei_2)
                    Cells(2, j + 1).Value = retsumei_2(j)
                Next j
                i = i + 1
                
            Else
            End If
                


        'データを読み込んでExcelシート(2行目以降)に出力する
        Do Until file.AtEndOfStream  'csvファイルの3行目~最終行目まで繰り返し
            line = file.ReadLine
            data = Split(line, ",")
                    
            For j = LBound(data) To UBound(data)
                Cells(i + 1, j + 1).Value = data(j)
            Next j
                
            i = i + 1
        Loop

        'csvファイルを閉じる
        file.Close
        
    End If
            
Next file

    
    
Call 関数(folder_Path)
       
End Sub
    

Sub 関数(folder_Path)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Folder = fso.GetFolder(folder_Path)

    For Each SUB_Folder In Folder.subfolders  'フォルダ内のサブフォルダ全てに処理を実行
        
        
            '選択したフォルダ内の全てのファイルに対して処理を行う
            For Each file In SUB_Folder.Files
                'ファイルの拡張子が.csvの場合、ファイルを開く
                If Right(file.Name, 4) = ".csv" Then
                    Set file = fso.OpenTextFile(file.Path)
                        
                        i = Range("A1048576").End(xlUp).Row
                        
                        '列名を取得する(1行目(i=1)を列名とする)
                        retsumei = Split(file.ReadLine, ",")
                        retsumei_2 = Split(file.ReadLine, ",")
                                
                        '1,2行目(A1セル始点)に列名を出力する(2シート名以降は列名無視)
                        If i = 1 Then
                            For j = LBound(retsumei) To UBound(retsumei)
                                Cells(1, j + 1).Value = retsumei(j)
                            Next j
                            For j = LBound(retsumei_2) To UBound(retsumei_2)
                                Cells(2, j + 1).Value = retsumei_2(j)
                            Next j
                            
                        Else
                        End If
                            
            
            
                    'データを読み込んでExcelシート(2行目以降)に出力する
                    Do Until file.AtEndOfStream  'csvファイルの3行目~最終行目まで繰り返し
                        line = file.ReadLine
                        data = Split(line, ",")
                                
                        For j = LBound(data) To UBound(data)
                            Cells(i + 1, j + 1).Value = data(j)
                        Next j
                            
                        i = i + 1
                    Loop
            
                    'csvファイルを閉じる
                    file.Close
                    
                End If
                        
            Next file
 
        
        Call 関数(SUB_Folder) 'サブフォルダ内のサブフォルダに処理を実行する
        
    Next SUB_Folder
    
End Sub

コメント