レコードによってカンマ数が一定していないCSV形式テキストファイルの読み込み処理です。ダブルクォーテーションに囲われた中での改行(項目内改行)についても対応しています。

組み込み用モジュールと、サンプルを用意しました。

(この画像をクリックすると、ダウンロードができます。)
サンプルは起動させると、「ファイルを開く」のダイアログが表示されます。

CSV形式テキストファイルを指定して「開く」をクリックすると読み込みが行なわれ、シートの2行目から表示されます。

組み込みモジュールは「modGetCSVRec3.bas」を使います。この中の「FP_GetCsvRec3」というFunctionプロシージャにOpenしたファイルナンバーを引数として呼び出すと、CSV項目が配列となって戻されます。
まずはその呼び出し部分の「READ_TextFile」プロシージャです。

'***************************************************************************************************
'   CSV形式ファイル読み込み処理(カンマ数不定処理)                   Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'20/03/17(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
Private Const g_cnsTitle As String = "テキストファイル読み込み処理"
Private Const g_cnsFilter As String = "全てのファイル (*.*),*.*"
Private Const g_cnsStartRow As Long = 2                         ' 読み込み開始行
Private Const g_cnsStartCol As Long = 1                         ' 読み込み開始カラム

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：READ_TextFile
'* 機能　　：CSV形式テキストファイル(不定カラム)読み込みサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年03月17日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：項目内改行の対応無しの前提となります
'***************************************************************************************************
Sub READ_TextFile()
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim lngRow As Long                                              ' セルの行番号
    Dim lngRec As Long                                              ' レコード件数カウンタ
    Dim lngCol As Long                                              ' CSV項目カラムINDEX
    Dim strFilename As String                                       ' ファイル名(フルパス)
    Dim vntFilename As Variant                                      ' ファイル名(受け取り)
    Dim vntRec As Variant                                           ' レコード内容(配列)
    '-----------------------------------------------------------------------------------------------
    ' ｢ファイルを開く｣ダイアログでファイル名の指定を受ける
    Application.StatusBar = "読み込むファイル名を指定して下さい。"
    vntFilename = Application.GetOpenFilename(FileFilter:=g_cnsFilter, Title:=g_cnsTitle)
    ' キャンセルされた場合は以降の処理は行なわない
    If VarType(vntFilename) = vbBoolean Then Exit Sub
    strFilename = vntFilename
    '-----------------------------------------------------------------------------------------------
    ' 指定ファイルをOPEN(入力モード)
    Set objFso = New FileSystemObject
    Set objTs = objFso.OpenTextFile(strFilename, ForReading)
    lngRow = g_cnsStartRow - 1
    ' EOF(End of File)まで繰り返す
    Do Until objTs.AtEndOfStream
        ' レコード件数カウンタの加算
        lngRec = lngRec + 1
        Application.StatusBar = "読み込み中です．．．．(" & lngRec & "レコード目)"
        ' 行単位にレコードを読み込む(共通処理)
        vntRec = modGetCSVRec3.FP_GET_CSV_REC2(objTs)
        lngCol = UBound(vntRec) + g_cnsStartCol
        ' 行を加算しレコード内容を配列転記(先頭は2行目)
        lngRow = lngRow + 1
        Range(Cells(lngRow, g_cnsStartCol), Cells(lngRow, lngCol)).Value = vntRec
    Loop
    '-----------------------------------------------------------------------------------------------
    ' 指定ファイルをCLOSE
    objTs.Close
    Application.StatusBar = False
    ' 処理終了
    Set objTs = Nothing
    Set objFso = Nothing
    ' 終了の表示
    MsgBox "ファイル読み込みが完了しました。" & vbCr & _
        "レコード件数=" & lngRec & "件", vbInformation, g_cnsTitle
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

ここで呼ばれている「FP_GetCsvRec3」は組み込みやすいように別モジュールにしてあります。

'***************************************************************************************************
'   CSV形式ファイル読み込み処理(カンマ数不定処理)                   modGetCSVRec3(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/07/25(1.00)新規作成
'20/03/17(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
Private Const g_cnsDq As String = """"
Private Const g_cnsDqCom As String = ""","
Private Const g_cnsCom As String = ","
Private Const g_cnsBlnk As String = ""
Private Const g_cnsProd As String = "."

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：FP_GetCsvRec3
'* 機能　　：CSV形式の1レコードの受け取り
'---------------------------------------------------------------------------------------------------
'* 返り値　：CSVレコード内容の1次配列(Array:Variant)
'* 引数　　：Arg1 = TextStream(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年07月25日
'* 作成者　：井上　治
'* 更新日　：2020年03月17日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：※現時点ではエラー処理なし
'***************************************************************************************************
Public Function FP_GetCsvRec3(objTs As TextStream) As Variant
    '-----------------------------------------------------------------------------------------------
    Dim lngPos As Long                                              ' 項目先頭カラム
    Dim lngPos2 As Long                                             ' 項目間のカンマ位置
    Dim lngIx As Long                                               ' 項目テーブルINDEX
    Dim lngLen As Long                                              ' レコード長
    Dim lngErr As Long                                              ' エラーコード
    Dim swTrue As Boolean                                           ' レコード連結判断スイッチ
    Dim swDq As Boolean                                             ' ダブルクォーテーションスイッチ
    Dim dteDate As Date                                             ' 日付試験用Work
    Dim strRec As String                                            ' レコード内容(連結後)
    Dim strRec2 As String                                           ' レコード内容(連結前)
    Dim strText As String                                           ' 1項目の内容
    Dim strText2 As String                                          ' Work
    Dim strChar As String                                           ' 1文字Work
    Dim tblFld() As Variant                                         ' レコード内容テーブル
    strRec = ""
    ' 項目途中改行対応のため､行末判定は独自に行なう
    Do Until swTrue
        '-----------------------------------------------------------------------
        swTrue = True
        ' レコードの読込み(TextStream)
        strRec2 = objTs.ReadLine
        ' 分断レコード対応のため文字列を接合する
        strRec = strRec & strRec2
        lngLen = Len(strRec)
        ' 配列を初期化
        lngIx = -1
        ReDim tblFld(0)
        ' レコード内容を1文字ずつ判定する
        lngPos = 1
        '-----------------------------------------------------------------------
        ' レコードの終端までのループ
        Do While lngPos <= lngLen
            '===================================================================
            ' 項目の次のカンマ位置探索用
            lngPos2 = lngPos + 1
            swDq = False
            strChar = Mid(strRec, lngPos, 1)
            ' 現在文字を判定
            Select Case strChar
                Case g_cnsDq
                    '=================================================
                    ' ダブルクォーテーション
                    '-------------------------------------------------
                    swDq = True
                    ' 先頭がダブルクォーテーションの場合､項目末の同文字を探す
                    Do While lngPos2 < lngLen
                        ' ダブルクォーテーション＋カンマ判定か
                        If Mid(strRec, lngPos2, 2) = g_cnsDqCom Then Exit Do
                        ' 次の文字へ
                        lngPos2 = lngPos2 + 1
                    Loop
                    ' 行末か
                    If lngPos2 >= lngLen Then
                        ' 行末に達した場合は正しい文字列か判定する
                        If Right(strRec, 1) = g_cnsDq Then
                            strText = Trim(Mid(strRec, lngPos + 1, lngLen - lngPos - 1))
                        Else
                            ' 不揃いの場合は次レコードを読み込むように指示する
                            strText = g_cnsBlnk
                            swTrue = False
                        End If
                    ElseIf lngPos2 > (lngPos + 1) Then
                        ' 両端のダブルクォーテーションを外す
                        strText = Trim(Mid(strRec, lngPos + 1, lngPos2 - lngPos - 1))
                    Else
                        strText = g_cnsBlnk
                    End If
                    ' 次の文字へ
                    lngPos2 = lngPos2 + 1
                Case g_cnsCom
                    '=================================================
                    ' カンマ
                    '-------------------------------------------------
                    ' カンマのみの場合はEmptyをセットさせる
                    strText = ""
                    ' 次の文字へ
                    lngPos2 = lngPos2 + 1
                Case Else
                    '=================================================
                    ' その他
                    '-------------------------------------------------
                    ' 先頭がダブルクォーテーションでない場合は単純にカンマを探す
                    Do While lngPos2 <= lngLen
                        ' カンマ発見か
                        If Mid(strRec, lngPos2, 1) = g_cnsCom Then Exit Do
                        ' 次の文字へ
                        lngPos2 = lngPos2 + 1
                    Loop
                    If lngPos2 > lngPos Then
                        strText = Trim(Mid(strRec, lngPos, lngPos2 - lngPos))
                    Else
                        strText = g_cnsBlnk
                    End If
            End Select
            '===================================================================
            ' テーブル要素数を追加して内容をセット
            lngIx = lngIx + 1
            ReDim Preserve tblFld(lngIx)
            ' 一旦大文字変換
            strText2 = UCase(strText)
            ' 状態判定
            Select Case True
                Case (IsNumeric(strText) And Not swDq)
                    '=================================================
                    ' 数値でダブルクォーテーションで囲われていない
                    '-------------------------------------------------
                    ' 小数点があるか
                    If InStr(1, strText, g_cnsProd, vbTextCompare) <> 0 Then
                        tblFld(lngIx) = CDbl(strText)   ' 実数は浮動小数点型に設定
                    Else
                        tblFld(lngIx) = CCur(strText)   ' 整数は通貨型に設定
                    End If
                Case IsDate(strText)
                    '=================================================
                    ' 日付
                    '-------------------------------------------------
                    tblFld(lngIx) = CDate(strText)      ' 日付型
                    On Error Resume Next
                    dteDate = tblFld(lngIx)
                    lngErr = Err.Number
                    On Error GoTo 0
                    If lngErr <> 0 Then
                        ' 日付エラー!
                        tblFld(lngIx) = strText         ' 文字列型に変更
                    ElseIf dteDate < #1/1/1900#Then
                        ' 日付範囲外
                        tblFld(lngIx) = strText         ' 文字列型に変更
                    Else
                        tblFld(lngIx) = dteDate
                    End If
                Case ((strText2 = "TRUE") Or (strText2 = "FALSE"))
                    '=================================================
                    ' BOOL
                    '-------------------------------------------------
                    tblFld(lngIx) = CBool(strText)      ' Boolean型
                Case strText <> g_cnsBlnk
                    '=================================================
                    ' 有効文字列
                    '-------------------------------------------------
                    tblFld(lngIx) = strText             ' 文字列型
                Case Else
                    '=================================================
                    ' 空項目
                    '-------------------------------------------------
                    ' ブランクの場合は初期化(Empty)
                    tblFld(lngIx) = Empty
            End Select
            ' 次項目の先頭位置をセット
            lngPos = lngPos2 + 1
        Loop
        '-----------------------------------------------------------------------
        ' EOFの場合は無条件に終了とする
        If objTs.AtEndOfStream Then swTrue = True
    Loop
    ' 配列を戻り値にセット
    FP_GetCsvRec3 = tblFld
End Function

'----------------------------------------<< End of Source >>----------------------------------------

※組み込み用「ツール」としておりますが「FP_GetCsvRec3」内ではエラー処理を行なっていません。実行時エラーに関する処理が必要であれば組み込んで下さい。
  また、CSV形式テキストファイルの「仕様」について所望するものと違う場合がありますのでご注意下さい。

IsNumeric関数についてご注意下さい。   本機能では、数字文字列のチェックにIsNumeric関数を用いていますが、このチェックは場合によっては誤動作することがあります。これはIsNumeric関数が16進数表現の文字を含む数字文字列を「数値」と判断することがあるからです。 これを避けるためには、IsNumeric関数ではなく、WorksheetFunctionのIsNumber関数を使うべきなのでしょうが、このサンプルはExcelVBAだけでなくVB系ユーザーも参考にされるため、あえてIsNumeric関数で押し通しています。
数値検査のための専用関数を作ることも可能なわけですが、CSV形式ファイルのやりとりを主眼とする場所での説明には不向きなのでこれも避けているわけですから、この点はご了承下さい。

Excelで「名前を付けて保存」させたCSV形式ファイルの読み出し

ここからはこれまでのサンプルとは異なり「Excelで名前を付けて保存させたCSV形式ファイル」をいきなりワークシートに展開するのではなく、 VBAのコードで処理します。これは最近ではWebシステムとのやりとりでこのような形式が増えてきています。
「Excelで名前を付けて保存させたCSV形式ファイル」は後で説明しますが、「セル内で改行」があったり、「セル内で半角カンマ」が使われたりするため、 CSV形式ファイルは単純に「改行で分解させて1件として処理」とか「カンマで分解させて項目ごとに分ける」ができないのです。

まずはサンプルで動作を確認してみて下さい。


(この画像をクリックすると、ダウンロードができます。)

ダウンロードしたZIPファイルを解凍すると、以下のファイルが出現します。

ファイル名	内容等
ReadCsvFile4SJIS.xlsm	CSV形式ファイル読み出し機能サンプル(シフトJIS版)　※マクロ有効ブック サンプルの起動プロシージャは「TEST1」です。(起動ボタン等はありません)
ReadCsvFile4UTF8.xlsm	CSV形式ファイル読み出し機能サンプル(UTF-8版)　　　※マクロ有効ブック サンプルの起動プロシージャは「TEST2」です。(起動ボタン等はありません)
テストデータ.csv	下の画像の簡単なCSV形式ファイルサンプルデータ(シフトJIS版のみ)

サンプルマクロが入ったマクロ有効ブックが2つありますが、これはCSV形式ファイルの文字コードによるものでそれ以外に機能的な違いはありません。 Excel2016以降では「CSV UTF-8(コンマ区切り)(*.csv)」という保存形式が追加されているため、 これに対応したものです。
同梱させているサンプルデータはシフトJIS版のみになるので、UTF-8にしたい場合はExcel2016以降で開いて、 「名前を付けて保存」で形式を変更させて下さい。

サンプルマクロは「TEST1」又は「TEST2」で、どちらもCSV形式ファイルを読み込んでから、 内部で二次元配列を作成させてアクティブシートに貼り付ける動作になっています。 CSV形式ファイルを直接開いたものと比較して動作が正しいか確認ができるようになっています。
この画面サンプルのように新規ブックを手前で開いて実行させると、マクロブック側にデータが貼り付くことが避けられます。



サンプルマクロを起動すると、開くCSV形式ファイルを指定するこの画面が表示されます。
CSV形式ファイルを指定して「開く」をクリックすると処理が実行されます。
添付のサンプルデータでは一瞬ですが、別の43列×43,000行のデータで試したところ、比較的新しいPCで 5秒程度でした。
(ファイルサイズでは10MB程度)



これが処理結果のExcel画面です。
例えば、3行目はC列がセル内で改行されており、7行目のG列はセル内の文字列内にカンマが含まれているのが判ります。
Excel画面に展開するのならExcelで開けば良いのですが、これは検証用にやっていることであって本来の目的はExcelで開かずに マクロ上で必要な処理を行なうことです。



「CSV形式ファイル」というのは実体は「テキストファイル」です。「メモ帳」や「テキストエディタ」で開くことができます。
行位置の説明をするため、行番号が表示される「テキストファイル」で開いてみました。1つ上のExcel画面と見比べて下さい。
まず、3～5行目はExcelシート上では3行目の内容であって、 C列がセル内で2回セル内改行されているため、テキスト上では3行となっています。
8～9行目もF列がセル内改行されており、Excelシート上では6行目の内容になります。
「セル内改行」か「通常の改行」かの違いは、セル内改行があるセルは項目がダブルクォーテーションで囲われる規則となっており、 ダブルクォーテーションで囲われた間での改行は「セル内改行」と判断して処理します。
実際の「セル内改行」はExcelシート上で「Alt+Enter」でキー入力された場合はLFコードのみなのですが、 外部から読み込まれたり貼り付けられたりしたものはCR+LFコードになってしまうようです。

「セル内カンマ」についても同様でダブルクォーテーションで囲われた間でのカンマは「セル内カンマ」と判断して処理します。(G7セル、テキストは10行目) このことはサンプルにはありませんが「セル内ダブルクォーテーション」も同様で、ダブルクォーテーションの場合はセル値がダブルクォーテーションで囲われるのとともに、 セル内のダブルクォーテーションは2つ連記に変換されます。

他システムからのCSV形式ファイルを取り込む場合はこれらが前提条件となります。



もう一点ですが、このページは「カンマ数不定のCSVファイル読み込み」というタイトルですが、このサンプルマクロではModule1側の定数で 行あたりの項目数を指定してチェックする方法を用意しています。
チェック自体を外してしまえば「カンマ数不定」にはなりますが、何かの処理に実装するとすればカンマ数は固定されるはずだし、 ExcelからのCSV形式保存では行ごとにカンマ数がバラつくことはないはずです。

ということでソースコードです。まずは「Module1」です。
これは今回作成したクラスの動作確認のための起動部分であって、このままご利用いただくものではありません。
実際に実行する前に以下のモジュールレベル定数の値を確認して下さい。クラスを呼び出す時のプロパティ値になります。

定数名	意味
g_cnsCheckColCnt	カラム数によるチェックを行なうかどうかの判定です。Trueにすると不正カラム数のレコードがあるとエラーになります。 Falseにした場合はチェックは行ないません。
g_cnsColCnt	チェックを行なう場合のカラム数です。 このサンプルの場合はこの定数をシートに貼り付ける列数として利用しています。実際のCSV形式ファイルの列数より大きい値になっていると実行時エラーになります。

'***************************************************************************************************
'   CSV読み込みテスト                                                   Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/11/06(1.00)新規作成
'19/11/09(1.10)カラム数チェック有無の指定を追加
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "CSV読み込みテスト"
Private Const g_cnsCheckColCnt As Boolean = True                    ' カラム数チェック有無
Private Const g_cnsColCnt As Long = 10                              ' カラム数
' ↑CSVファイルのカラム数をg_cnsColCntにセットしてから実行して下さい
'   チェック不要の場合はg_cnsCheckColCntをFalseに変更して下さい

'***************************************************************************************************
'* 処理名　：TEST1
'* 機能　　：CSV読み込みテスト
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月06日
'* 作成者　：井上　治
'* 更新日　：2019年11月09日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub TEST1()
    '-----------------------------------------------------------------------------------------------
    Dim lngIxR As Long                                              ' テーブルINDEX(Row)
    Dim lngIxC As Long                                              ' テーブルINDEX(Col)
    Dim lngIxRMax As Long                                           ' テーブルINDEX上限(Row)
    Dim strFilename As String                                       ' ファイル名
    Dim strErrMSG As String                                         ' エラーメッセージ
    Dim vntFilename As Variant                                      ' ファイル名(受け取り)
    Dim tblRec As Variant                                           ' JAG配列テーブル
    Dim tblRec2() As Variant                                        ' 二次元配列テーブル
    '-----------------------------------------------------------------------------------------------
    ' ファイル名受け取り
    vntFilename = Application.GetOpenFilename("CSVファイル (*.csv;*.txt),*.csv;*.txt", , g_cnsTitle)
    ' キャンセルは終了
    If VarType(vntFilename) = vbBoolean Then Exit Sub
    strFilename = vntFilename
    '-----------------------------------------------------------------------------------------------
    ' CSV読み込みクラス(Ascii/シフトJIS)
    With New clsReadCsv1
        ' カラム数チェック有無を指定
        .prpCheckColCnt = g_cnsCheckColCnt
        ' カラム数を指定
        .prpColCnt = g_cnsColCnt
        ' CSV読み込み
        If Not .ReadCsv(strFilename, tblRec) Then
            MsgBox .prpErrMSG, vbCritical, g_cnsTitle
            Exit Sub
        End If
    End With
    '===============================================================================================
    ' 以下はサンプルとしての結果検証用の記述です
    ' カラム数チェックを行なわない指定でもg_cnsColCntの指定列までしかシートには書き出されません
    '-----------------------------------------------------------------------------------------------
    lngIxRMax = UBound(tblRec)
    ReDim tblRec2(lngIxRMax, g_cnsColCnt - 1)
    ' JAG配列テーブルを二次元配列テーブルに変換
    Do While lngIxR <= lngIxRMax
        lngIxC = 0
        ' カラム方向ループ
        Do While lngIxC < g_cnsColCnt
            tblRec2(lngIxR, lngIxC) = tblRec(lngIxR)(lngIxC)
            ' 次へ
            lngIxC = lngIxC + 1
        Loop
        ' 次へ
        lngIxR = lngIxR + 1
    Loop
    ReDim tblRec(0)
    '-----------------------------------------------------------------------------------------------
    ' 現在シートに貼り付け
    With ActiveSheet
        .Range(.Cells(1, 1), .Cells(lngIxR, g_cnsColCnt)).Value = tblRec2
    End With
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

Module1では、どちらもほぼ同様のコーディングで中央付近の呼び出しクラス名が換わるだけです。
モジュール定数は必要に応じて変更して下さい。
指定ファイルの読み込みとファイル内容をJAG配列にするところまでを下で説明するクラス側が担当しており、 それ以降の作業は戻されたJAG配列から処理本体が行なうので、 このサンプルではJAG配列を二次元配列に置き換えてワークシートに貼り付けています。



念のために説明しておきますが「JAG配列」とは一次元配列の中に別の一次元配列を格納させる方法です。
VB系言語では、ReDimステートメントで配列要素数を動的に変更できるのは最終次元だけなので、Excelシートのような縦横の二次元配列の 縦方向については途中で配列要素数の動的変更はできないのです。
ここで活躍するのが「JAG配列」です。 「単純配列の中に単純配列を入れる」ということなので縦方向でも配列要素数の動的変更が可能です。
今回のようなCSV形式ファイルでは改行数をカウントできたとしても縦方向の配列要素数にはならないのですから、 配列要素数の動的変更は必須条件になります。

次は「clsReadCsv1」です。こちらはシフトJIS版の方の実処理クラスになります。 UTF-8版の方は「clsReadCsv2」になっています。
公開プロシージャ「ReadCsv」は、先にプロパティ「prpCheckColCnt」でカラム数チェックの有無と、「prpColCnt」でCSV形式ファイルのカラム数を指定してから呼び出すようになっています。

'***************************************************************************************************
'   CSV読み込みクラス                                               clsReadCsv1(Class)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [前提条件]
'   ・カンマ区切りテキストファイルであること
'   ・文字コードはAscii/シフトJIS形式
'   ・改行コードはCR、LF、CRLFに対応
'   ・フィールド数は全行一致していること(チェック有効時)
'   ・フィールド内で改行、あるいはフィールド内にカンマ、ダブルクォーテーションがある場合は
'   　フィールド自体をダブルクォーテーションで囲うこと
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'19/11/06(1.00)新規作成
'19/11/09(1.10)LFコードのみの改行に対応、カラム数チェック有無の指定を追加
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsCom As String = ","
Private Const g_cnsDq As String = """"
'---------------------------------------------------------------------------------------------------
Private g_blnCheckColCnt As Boolean                                 ' カラム数チェック有無
Private g_lngColCnt As Long                                         ' チェック時のカラム数
Private g_strErrMSG As String                                       ' エラーメッセージ

'***************************************************************************************************
'   ■■■ 公開プロシージャ ■■■
'***************************************************************************************************
'* 処理名　：ReadCsv
'* 機能　　：CSV読み込み
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = ファイル名(String)                      ※フルパス
'* 　　　　　Arg2 = CSV内容JAG配列テーブル(Variant)         ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月06日
'* 作成者　：井上　治
'* 更新日　：2019年11月09日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Friend Function ReadCsv(ByVal strFilename As String, _
                        ByRef tblRec As Variant) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim strAllRec As String                                         ' レコード全体
    ReadCsv = False
    g_strErrMSG = ""
    ReDim tblRec(0)
    ' カラム数未設定は終了(チェック有効時)
    If g_blnCheckColCnt And g_lngColCnt = 0 Then
        g_strErrMSG = "カラム数が設定されていません。"
        Exit Function
    End If
    ' CSVファイル読み込み
    If Not FP_ReadFile(strFilename, strAllRec) Then Exit Function
    ' CSVファイル内容をJAG配列に変換
    If Not FP_GetJagTable(strAllRec, tblRec) Then Exit Function
    ' 終了
    ReadCsv = True
End Function

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名　：FP_ReadFile
'* 機能　　：CSVファイル読み込み
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = ファイル名(String)                      ※フルパス
'* 　　　　　Arg2 = レコード全体(String)                    ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月06日
'* 作成者　：井上　治
'* 更新日　：2019年11月06日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_ReadFile(ByVal strFilename As String, _
                             ByRef strAllRec As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim objTs As TextStream                                         ' TextStream
    Dim blnOpen As Boolean                                          ' OPEN判定
    FP_ReadFile = False
    On Error GoTo ReadFile_ERROR
    Set objFso = New FileSystemObject
    ' CSVファイルOPEN
    Set objTs = objFso.OpenTextFile(strFilename, ForReading, False)
    blnOpen = True
    ' ファイル全量を読み込み
    strAllRec = objTs.ReadAll
    FP_ReadFile = True
    GoTo ReadFile_EXIT

'===================================================================================================
ReadFile_ERROR:
    g_strErrMSG = Err.Description

'===================================================================================================
ReadFile_EXIT:
    ' CSVファイルCLOSE
    If blnOpen Then objTs.Close
    Set objTs = Nothing
    Set objFso = Nothing
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名　：FP_GetJagTable
'* 機能　　：CSVファイル内容をJAG配列に変換
'---------------------------------------------------------------------------------------------------
'* 返り値　：処理成否(Boolean)
'* 引数　　：Arg1 = レコード全体(String)
'* 　　　　　Arg2 = CSV内容JAG配列テーブル(Variant)         ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月06日
'* 作成者　：井上　治
'* 更新日　：2019年11月09日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetJagTable(ByRef strAllRec As String, _
                                ByRef tblRec As Variant) As Boolean
    '-----------------------------------------------------------------------------------------------
    ' 全体で使用する変数
    Dim lngIxRec As Long                                            ' レコードINDEX
    Dim lngPos As Long                                              ' 現在文字位置
    Dim lngPosEnd As Long                                           ' 最終文字位置
    Dim lngCntRec As Long                                           ' レコードカウンタ
    ' レコード単位で使用する変数
    Dim lngIxFld As Long                                            ' フィールドINDEX
    Dim lngCntFld As Long                                           ' フィールドカウンタ
    Dim blnCrLf As Boolean                                          ' 改行判定
    Dim blnOkRec As Boolean                                         ' 有効レコード判定
    Dim tblFld() As String                                          ' フィールドテーブル
    ' フィールド単位で使用する変数
    Dim lngPosS As Long                                             ' 項目開始位置
    Dim lngPosE As Long                                             ' 項目終了位置
    Dim lngPosS2 As Long                                            ' 項目開始位置(DQ調整後)
    Dim lngPosE2 As Long                                            ' 項目終了位置(DQ調整後)
    Dim blnInText As Boolean                                        ' 文字列項目内判定
    Dim blnDq As Boolean                                            ' ダブルクォーテーション判定
    Dim blnDq2 As Boolean                                           ' 文字列内DQ発生判定
    Dim strText As String                                           ' 項目テキストWORK
    '-----------------------------------------------------------------------------------------------
    FP_GetJagTable = False
    lngPos = 1
    lngIxRec = -1
    lngPosEnd = Len(strAllRec)
    ' 内容無しはエラー
    If lngPosEnd = 0 Then
        g_strErrMSG = "ファイルに内容が書き込まれていません。"
        Exit Function
    End If
    '-----------------------------------------------------------------------------------------------
    ' 最終文字位置まで繰り返す
    Do While lngPos <= lngPosEnd
        '=============================================================
        ' レコード単位[前]処理
        '-------------------------------------------------------------
        blnCrLf = False
        blnOkRec = False
        lngIxFld = -1
        lngCntFld = 0
        ReDim tblFld(0)
        '=============================================================
        ' レコード単位[主]処理(レコード内項目巡回)
        '-------------------------------------------------------------
        Do While lngPos <= lngPosEnd
            '-----------------------------------------------
            ' フィールド単位[前]処理
            '-----------------------------------------------
            blnInText = False
            blnDq = False
            blnDq2 = False
            ' 項目先頭位置
            lngPosS = lngPos
            '-----------------------------------------------
            ' フィールド単位[主]処理
            '-----------------------------------------------
            Do While lngPos <= lngPosEnd
                ' 現在文字を判定
                Select Case Mid(strAllRec, lngPos, 1)
                    Case vbCr                               ' CRコード
                        ' 文字列項目内でなければレコード終了
                        If Not blnInText Then
                            blnCrLf = True
                            Exit Do
                        End If
                    Case vbLf                               ' LFコード
                        ' 文字列項目内でなければレコード終了
                        If Not blnInText Then
                            blnCrLf = True
                            Exit Do
                        End If
                    Case g_cnsDq                            ' ダブルクォーテーション
                        ' 文字列内DQ発生判定か
                        If blnInText Then
                            blnDq2 = True
                        End If
                        blnInText = Not blnInText
                        blnDq = True
                    Case g_cnsCom                           ' カンマ
                        ' 文字列項目内でなければ項目終了
                        If Not blnInText Then Exit Do
                End Select
                ' 次の文字へ
                lngPos = lngPos + 1
            Loop
            '-----------------------------------------------
            ' フィールド単位[後]処理
            '-----------------------------------------------
            ' 項目終了位置(実際は次のカンマ位置)
            lngPosE = lngPos
            lngPosS2 = lngPosS
            lngPosE2 = lngPosE
            ' ダブルクォーテーションで囲われているか
            If blnDq Then
                ' 両端文字(ダブルクォーテーション)を除外
                lngPosS2 = lngPosS + 1
                lngPosE2 = lngPosE - 1
            End If
            lngCntFld = lngCntFld + 1
            ' フィールドテーブル要素を追加
            lngIxFld = lngIxFld + 1
            ReDim Preserve tblFld(lngIxFld)
            ' 有効なフィールドか(ブランクでないか)
            If lngPosE2 > lngPosS2 Then
                blnOkRec = True
                ' 項目テキストの取り出し
                strText = Mid(strAllRec, lngPosS2, lngPosE2 - lngPosS2)
                ' 文字列内ダブルクォーテーション発生判定
                If blnDq2 Then
                    ' ダブルクォーテーション連記を解除(完璧な方法ではない)
                    strText = Replace(strText, """""", """")
                End If
                ' フィールドテーブルに格納
                tblFld(lngIxFld) = strText
            End If
            ' カンマ､改行を除外するため+1
            lngPos = lngPosE + 1
            ' レコード終了判定
            If blnCrLf Then Exit Do
        Loop
        '=============================================================
        ' レコード単位[後]処理
        '-------------------------------------------------------------
        ' Cr後のLfは除外
        If Mid(strAllRec, lngPos, 1) = vbLf Then
            lngPos = lngPos + 1
        End If
        ' 有効レコードならJAG配列テーブルに格納
        If blnOkRec Then
            lngCntRec = lngCntRec + 1
            ' 項目数判定
            If g_blnCheckColCnt And lngCntFld <> g_lngColCnt Then
                Call GP_AppendMessage(CStr(lngCntRec) & "REC目、項目数不正(" & lngCntFld & ")")
            End If
            lngIxRec = lngIxRec + 1
            ReDim Preserve tblRec(lngIxRec)
            tblRec(lngIxRec) = tblFld
        End If
    Loop
    ' 有効内容無し
    If lngCntRec = 0 Then
        g_strErrMSG = "有効な内容がありません。"
    End If
    ' エラーがなければOK
    FP_GetJagTable = g_strErrMSG = ""
End Function

'***************************************************************************************************
'* 処理名　：GP_AppendMessage
'* 機能　　：メッセージ累積
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 今回メッセージ(String)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2019年11月06日
'* 作成者　：井上　治
'* 更新日　：2019年11月06日
'* 更新者　：井上　治
'* 機能説明：改行を挟んでメッセージを累積する
'* 注意事項：
'***************************************************************************************************
Private Sub GP_AppendMessage(ByVal strAddMSG As String)
    '-----------------------------------------------------------------------------------------------
    If g_strErrMSG <> "" Then g_strErrMSG = g_strErrMSG & vbCrLf
    g_strErrMSG = g_strErrMSG & strAddMSG
End Sub

'***************************************************************************************************
'   ■■■ プロパティ ■■■
'***************************************************************************************************
'   カラム数チェック有無(Boolean)
'---------------------------------------------------------------------------------------------------
Friend Property Let prpCheckColCnt(ByVal blnValue As Boolean)
    g_blnCheckColCnt = blnValue
End Property

'===================================================================================================
'   チェック時のカラム数(Long)
'---------------------------------------------------------------------------------------------------
Friend Property Let prpColCnt(ByVal lngValue As Long)
    g_lngColCnt = lngValue
End Property

'===================================================================================================
'   エラーメッセージ(String)
'---------------------------------------------------------------------------------------------------
Friend Property Get prpErrMSG() As String
    prpErrMSG = g_strErrMSG
End Property

'----------------------------------------<< End of Source >>----------------------------------------

外部から呼ばれるプロシージャ「ReadCsv」の内部動作は次の2工程に分かれています。

プロシージャ	処理内容
FP_ReadFile	指定ファイル名のCSV形式ファイルをEOFまで全量を読み出し、文字列変数で返す処理です。 この処理は「clsReadCsv1」と「clsReadCsv2」で文字コードの違いから処理記述が異なります。
FP_GetJagTable	渡されたファイル全量の内容から1文字ずつ判定しながら列方向の配列を作成し、さらに行方向の配列に列方向の配列を納めていく作業を行なう処理で、 結果としてJAG配列を返します。 この処理は「clsReadCsv1」「clsReadCsv2」とも処理記述は全く同じです。 全体ループ(EOFまで)、レコード単位ループ(セル外の改行発見まで)、 フィールドループ(項目境界かセル外改行が見つかるまで)の3重ループ処理になっています。

このクラスは実務にご利用いただけると思います。

←ReadCsvFile4.zip       (56KB)