編集

【ExcelVBA】フォルダー内の複数CSVファイルを取り込む

｜2025/06/06
ExcelVBA #008 フォルダー内の複数CSVファイルを取り込む

今回は、フォルダに格納されている複数のCSVファイルをExcelのシートに取り込む処理をご紹介します。なお、各CSVファイルのフォーマット自体は揃っているという前提です（タイトル名や項目列の並びなど）。

動作としては、参照ボタンを押してフォルダを選択した後、読み込み開始ボタンを押すことで新しいシートにCSVデータを書き出す処理を行います。１つのファイルに対して「読み込み→書き出し」を行い、ファイルの件数分を繰り返すというものです。

CSVファイルの取り込みについては、以前ご紹介した『UTF-8のCSVをExcelのシートに取り込む』の応用編になります。今回はフォルダに格納されたファイルを１つずつ取り出すという繰り返し処理があるため、過去記事のソースコードを一部変更しています。

特定の１ファイルのみ取り込みたい場合は過去記事をご参照ください。

▼過去記事：UTF-8のCSVをExcelのシートに取り込む

【ExcelVBA】UTF-8のCSVをExcelのシートに取り込む | ともゆきの独り言（雑記ブログ）

【ExcelVBA】UTF-8のCSVをExcelのシートに取り込む | ともゆきの独り言（雑記ブログ）

UTF-8のCSVをExcelのシートに取り込む処理の備忘録です。動作としては、参照ボタンを押してCSVファイルを選択した後、読み込み開始ボタンを押すことで新しいシートにCSVデータを書き出す処理を行います。

www.tomoyuki0.com

▼過去記事：Shift-JISのCSVをExcelのシートに取り込む

【ExcelVBA】Shift-JISのCSVをExcelのシートに取り込む | ともゆきの独り言（雑記ブログ）

【ExcelVBA】Shift-JISのCSVをExcelのシートに取り込む | ともゆきの独り言（雑記ブログ）

今回は、Shift-JISのCSVをExcelのシートに取り込むコードをご紹介します。単純にLineInputでの読み込みなので、難しい処理ではありません。動作としては、参照ボタンを押してファイルを選択した後、読み込み開始ボタンを押すことで新しいシートにCSVデータを書き出す処理を行います。

www.tomoyuki0.com

画面設計

画面設計
  • シート名：設定情報
  • 名前付け：セルD4「CSVフォルダ」
  • 参照ボタン：「フォルダ選択」マクロを指定
  • 読み込み開始ボタン：「MainProcess」マクロを指定

入力データ

フォルダ構成

フォルダ構成

フォルダ名：2025年

マクロファイルと同じ階層に年フォルダが用意されているものとします。年フォルダの中に、月別のCSVファイルが格納されています。なお、CSVファイルはutf-8のBOM付きです。

入力データ

入力データ①
入力データ②

ファイル名：4月.csv、5月.csv、6月.csv

サンプルデータは取り敢えず３件ほど用意しました。

処理実行結果

処理実行結果

指定したフォルダにあるCSVファイルの内容が、マクロファイル内に新しいシートとしてそれぞれ用意されます。

フォルダに格納されている複数CSVファイルを取り込む - ソースコード（ExcelVBA）

Option Explicit
Private ObjADO As ADODB.Stream 'Microsoft ActiveX Data Objects X.X Library
Private ObjFSO As FileSystemObject 'Microsoft Scripting Runtime
──────────────────────────────────────────────────────────────────────────────
Sub MainProcess()

    '初期処理
    Set ObjADO = New ADODB.Stream
    Set ObjFSO = New FileSystemObject
    
    '設定情報の読み込み
    Dim WS As Worksheet
    Dim FolderPath As String
    Set WS = ThisWorkbook.Worksheets("設定情報")
    FolderPath = WS.Range("CSVフォルダ")
    
    '指定フォルダの存在チェック
    If ObjFSO.FolderExists(FolderPath) = False Then
        MsgBox "フォルダが存在しません。"
        End
    End If

    'フォルダに格納してあるCSVファイルの読み込み
    Dim YearFolder As Folder
    Dim FilesCollection As Files
    Dim CurrentFile As File
    Dim FileName As String
    Set YearFolder = ObjFSO.GetFolder(FolderPath)
    Set FilesCollection = YearFolder.Files
    For Each CurrentFile In FilesCollection
        FileName = ObjFSO.GetBaseName(CurrentFile)
        Call CSVImport(CurrentFile, FileName)
    Next

    '後処理
    Set ObjFSO = Nothing
    Set ObjADO = Nothing

End Sub
──────────────────────────────────────────────────────────────────────────────
Sub CSVImport(ByRef filePath As Variant, ByRef sheetName As String)
   
    'レコード数取得
    Dim csvRow As Long
    With ObjFSO.OpenTextFile(filePath, 8)
        csvRow = .Line
        .Close
    End With
    
    '新規シート作成
    Dim newWS As Worksheet
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
    Set newWS = ActiveSheet
    
    'CSV取り込み
    Dim readString As String
    Dim tmp As Variant
    Dim i As Long
    Dim j As Long
    ReDim Arry(0 To csvRow, 100)
    ObjADO.Type = 2 'テキストのデータ型を指定（1:adTypeBinary…バイナリデータ/2:adTypeText…テキストデータ）
    ObjADO.Charset = "utf-8" '文字コードを指定（UTF-8/Shift_JIS/euc-jp/ISO-2022-JP/Unicode など）
    ObjADO.LineSeparator = -1 '改行コードを指定（13:adCR/-1:adCRLF/10:adLF）
    ObjADO.Open 'Streamのオープン
    ObjADO.LoadFromFile (filePath) 'ファイル読み込み
    Do While Not ObjADO.EOS
        readString = ObjADO.readText(-2) 'テキストを１行読み込む
        readString = replaceColon(readString)  '受け取った文字列のカンマをコロンに置き換える（ダブルクォーテーションで囲まれているカンマは置き換えない）
        tmp = Split(Replace(replaceColon(readString), """", ""), ":") 'strLineをコロンで区切り配列に格納
        For j = 0 To UBound(tmp)
            Arry(i, j) = tmp(j)
        Next j
        i = i + 1
    Loop
    ObjADO.Close 'Streamのクローズ

    '配列の転記
    Range("A1:CR" & csvRow + 1) = Arry
    
End Sub
──────────────────────────────────────────────────────────────────────────────
Function replaceColon(ByVal str As String) As String

    Dim strTemp As String
    Dim quotCount As Long
    Dim l As Long
    For l = 1 To Len(str)  'strの長さだけ繰り返す
        strTemp = Mid(str, l, 1) 'strから現在の1文字を切り出す
        If strTemp = """" Then   'strTempがダブルクォーテーションなら
            quotCount = quotCount + 1   'ダブルクォーテーションのカウントを1増やす
        ElseIf strTemp = "," Then   'strTempがカンマなら
            If quotCount Mod 2 = 0 Then   'quotCountが2の倍数なら
                str = Left(str, l - 1) & ":" & Right(str, Len(str) - l)   '現在の1文字をコロンに置き換える
            End If
        End If
    Next l
    replaceColon = str

End Function

ポイント

  1. ソースコード内で使用するライブラリについては「事前バインディング」のため、メニューの「ツール」から参照設定でそれぞれチェックを入れてください。
    Private ObjWSH As WshShell ➡ Windows Script Host Object Model
    Private ObjADO As ADODB.Stream ➡ Microsoft ActiveX Data Objects X.X Library
    Private ObjFSO As FileSystemObject ➡ Microsoft Scripting Runtime
  2. フォルダ内にある各ファイルの繰り返し処理は、以前ご紹介した「ファイル一覧作成」の処理と同様です。対象フォルダーをフォルダー型変数「YearFolder」に格納し、そこから更に複数ファイルのコレクション型変数「FilesCollection」を作成します。作成したコレクション型変数をFor Each ～ Nextでループさせます。また、フォルダ選択ダイアログのマクロもこちらに掲載しております。

    ▼過去記事：フォルダ選択ダイアログ、ファイル一覧出力、セルの書式設定、etc.

    【ExcelVBA】フォルダ選択ダイアログ、ファイル一覧出力、セルの書式設定、etc. | ともゆきの独り言（雑記ブログ）

    【ExcelVBA】フォルダ選択ダイアログ、ファイル一覧出力、セルの書式設定、etc. | ともゆきの独り言（雑記ブログ）

    GoogleのBloggerで雑記ブログ。楽天経済圏,ExcelVBA,お絵かき,ゲームプレイ記,プロ野球観戦（楽天イーグルス）

    www.tomoyuki0.com
  3. CSVを取り込む際、CSVのファイル名をシート名とさせたいので、FileSystemObjectのGetBaseNameで拡張子を除いたファイル名を取得しています。取得した文字列をCSVImportの引数として渡すことで、その文字列でシート名を作成します。