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