コードを紹介。コードと記事内容は追って推敲予定。
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
コメント