vba 複数CSVファイル読む、EXCELフォーマットに出力サンプル

```
Option Explicit

Dim outSheet As Worksheet
Dim inputFileFolder As String
Dim path As String
Dim fileExFlg As Boolean

'実行ボタンクリック
Private Sub btn_Generate_Click()


If Len(Sheet1.inputFileFolder.Text) = 0 Then
    Call MsgBox("入力フォルダを入力してください。", vbOKOnly + vbCritical)
    Exit Sub
End If

Call mainPross(Sheet1.inputFileFolder.Text)

End Sub
 ' 選択ボタンクリック
Public Sub selectButton_Click()

    Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = Sheet1.inputFileFolder.Text
    If Not Application.FileDialog(msoFileDialogFolderPicker).Show Then
      Exit Sub
      
    End If
    Sheet1.inputFileFolder = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub

Public Sub mainPross(inputFileFolder As String)
Windows.Application.ScreenUpdating = False

Call ExecEachFolder(inputFileFolder, "**")

End Sub

'入力ディレクトリ再帰して、全部ファイルを繰り返す。
Public Function ExecEachFolder(folderPath As String, kaku As String)

Dim targetWorkbook As Workbook
Dim FSO As New FileSystemObject
Dim fe As FILE

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.ScreenUpdating = False


'check CSV path
checkPach folderPath
'check format file1 path
File_DirSample Sheet1.TextBox1.Value
'check format file2 path
File_DirSample Sheet1.TextBox2.Value
'check output path
checkPach Sheet1.TextBox3.Value

'フォーマットファイルを開く
Set targetWorkbook = Workbooks.Open(Sheet1.TextBox1.Value)
Set targetWorkbook = Workbooks.Open(Sheet1.TextBox2.Value)

' フォルダ内のCSVファイルを処理する
For Each fe In FSO.GetFolder(folderPath).Files
    Dim folderNm As String
    folderNm = Split(folderPath, "\")(UBound(Split(folderPath, "\")))
    Dim fp As String: fp = fe.path
    Dim en As String: en = LCase(FSO.GetExtensionName(fp))

    If en = "csv" Then

        'ファイル存在の場合、ファイルをOPENして、処理を行う
        doBlogic fe.path
    ElseIf en = "xlsx" Then
    
    End If
    Set fe = Nothing
 Next


' サブフォルダに再帰的に検索する
Dim fr As Folder
For Each fr In FSO.GetFolder(folderPath).SubFolders
    Call ExecEachFolder(fr.path, kaku)
    Set fr = Nothing
Next

Set FSO = Nothing
Windows("f1.xlsx").Activate
ActiveWorkbook.SaveAs Filename:=Sheet1.TextBox3.Value & "/" & Replace(Replace(Replace(Now, "/", ""), ":", ""), " ", "") & "f1.xlsx"
ActiveWindow.Visible = True
Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("f2.xlsx").Activate
ActiveWorkbook.SaveAs Filename:=Sheet1.TextBox3.Value & "/" & Replace(Replace(Replace(Now, "/", ""), ":", ""), " ", "") & "f2.xlsx"

ActiveWindow.Visible = True
Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Close
a1: Exit Function
 End Function

'ファイルをOPENして、自分の業務処理ロジックを書く
Public Function doBlogic(filepath As String)
 
 
On Error GoTo 1
'TODO TextBox1の値をチェック必要
'ファイル開く場合、非表示

'CSVファイルの名前を取得する
 Dim pos As String
 Dim pathName As String
 Dim filename1 As String
 pos = InStrRev(filepath, "\")
 pathName = Left(filepath, pos)
 filename1 = Mid(filepath, pos + 1)

 
 'CSVファイルよみ、EXCELファイルに書く
 Dim buf  As String
 
 Open filepath For Input As #1
 Do Until EOF(1)
   Line Input #1, buf
   '読み込んだデータをセルに代入する
   Dim tmp As Variant
   Dim n As Integer
   tmp = Split(buf, ",")
   n = n + 1
   If filename1 = "c1.csv" Then
     Windows("f1.xlsx").Activate
     Dim i As Integer
     
     For i = 0 To UBound(tmp)
       Cells(n, i + 1) = tmp(i)
     Next i
   ElseIf filename1 = "c2.csv" Then
     Windows("f2.xlsx").Activate
       For i = 0 To UBound(tmp)
         Cells(n + 1, i + 1) = tmp(i)
       Next i
   ElseIf filename1 = "c3.csv" Then
     Windows("f1.xlsx").Activate
       For i = 0 To UBound(tmp)
         Cells(n + 2, i + 1) = tmp(i)
       Next i
     Windows("f2.xlsx").Activate
       For i = 0 To UBound(tmp)
         Cells(n + 3, i + 1) = tmp(i)
       Next i
   End If
 Loop

Close #1
1:
End Function

'checp path

Sub checkPach(filepath As String)
    ''Subフォルダが存在するかどうか調べます
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(filepath) Then
        
    Else
        MsgBox filepath & "フォルダは存在しません"
        End
    End If
    Set FSO = Nothing
End Sub

'check DIR
Sub File_DirSample(filepath As String)
 
  Dim flSample As String

  
  'ファイル名の取得
  flSample = Dir(filepath)
  
  'ファイルの存在有無を判定
  If Len(flSample) <> 0 Then
      
    Else
      '「無し」の結果をメッセージボックスで表示
      MsgBox (filepath & "は存在しません"), vbCritical
      End
  End If
 
End Sub

```
![image](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/197416/9fe4059d-f494-2e95-f2bc-25cb729ef0fb.png)