[vba]データ中に「,」を含むcsvファイルの読み込み

ソースコード

Option Explicit
'
' 参照設定
' Microsoft ActiveX Data Objects Access Library
'


' csvの区切り文字
' データ中に含まれないであろう1文字を採用している
Public Const NEW_SEPARATOR As String = "┻"
'
' [機能]
'   csvファイル読み込み
'   ファイルのデータ中にカンマを含まないことを前提とする
' [引数]
'   path : csvファイルのパス
'   char_code : csvファイルの文字コード
' [戻り値]
'   csvのデータを格納した二次元配列
'
Public Function LoadCsv(path As String, char_code As String, column As Long) As Variant
    
    ' ファイル読み込み
    Dim buf As String
    Dim ado As New ADODB.Stream
    With ado
        .Charset = "shift_jis"
        .Type = adTypeText          ' テキスト形式で読みこむ。
        .Open
        .LoadFromFile (path)
        buf = .ReadText
        .Close
    End With
    Set ado = Nothing

    ' 形式変換
    Dim data() As Variant
    Dim lines() As String
    lines = Split(buf, vbCrLf)
    
    Dim i As Long
    Dim j As Long
    ReDim data(UBound(lines), column - 1)
    For i = 0 To UBound(lines)
        Dim items() As String
        items = Split(lines(i), ",")
        For j = 0 To column - 1
            data(i, j) = items(j)
        Next
    Next
    
    LoadCsv = data
End Function

'
' [機能]
'   csvファイル読み込み
'   ファイルのデータ中にカンマを含む場合でも動作する
' [引数]
'   path : csvファイルのパス
'   char_code : csvファイルの文字コード
' [戻り値]
'   csvのデータを格納した二次元配列
'
Public Function LoadCsvSafety(path As String, char_code As String, column As Long) As Variant
    
    ' ファイル読み込み
    Dim buf As String
    Dim ado As New ADODB.Stream
    With ado
        .Charset = char_code
        .Type = adTypeText          ' テキスト形式で読みこむ。
        .Open
        .LoadFromFile (path)
        buf = .ReadText
        .Close
    End With
    Set ado = Nothing

    ' 形式変換
    Dim data() As Variant
    Dim lines() As String
    lines = Split(buf, vbCrLf)
    
    Dim i As Long
    Dim j As Long
    ReDim data(UBound(lines), column - 1)
    For i = 0 To UBound(lines)
        Dim items() As String
        Dim comma_replaced_line As String
        comma_replaced_line = ReplaceSeparator(lines(i), NEW_SEPARATOR)
        items = Split(comma_replaced_line, NEW_SEPARATOR)
        For j = 0 To column - 1
            data(i, j) = items(j)
        Next
    Next
    
    LoadCsvSafety = data
End Function

'
' [機能]
'   csvの区切り文字をカンマから別の文字に置換する
' [引数]
'   line : 1行テキスト
'   new_separator : 新しい区切り文字
' [戻り値]
'   new_separatorで置換された1行テキスト
'
Private Function ReplaceSeparator(line As String, new_separator As String) As String

    Const QUOTE As String = """"
    Const COMMA As String = ","

    Dim quote_count As Long
    quote_count = 0
    
    Dim i As Long
    Dim c As String
    For i = 1 To Len(line)
        ' 1文字取得
        c = Mid(line, i, 1)
        If (c = QUOTE) Then
            quote_count = quote_count + 1
        ElseIf (c = COMMA) Then
            If (quote_count Mod 2 = 0) Then
                line = Left(line, i - 1) & new_separator & Right(line, Len(line) - i)
            End If
        End If
    Next
    ReplaceSeparator = line
End Function