【Excel】色々な方法でCSVファイルの読み込みを試してみよう【VBA】

Public Enum QtCharset
    SJIS = 932
    UTF8 = 65001
    UTF16 = 1200
End Enum

Public Sub ReadCSVByQueryTable()
    Dim ws As Worksheet
    Dim conn As String

    conn = "TEXT;" & "[anyPath]"                        ' -> ファイルパス
    Set ws = ThisWorkbook.Worksheets("[sheetIndex]")    ' -> 出力先シート

    ' CSVに接続
    With ws.QueryTables.Add(conn, ws.Range("A1"))
    .TextFilePlatform = QtCharset.SJIS                  ' -> 文字コード
    .TextFileCommaDelimiter = True                      ' -> カンマ区切り
    .RefreshStyle = xlInsertEntireRows                  ' -> 上書き出力
    .Refresh                                            ' -> 出力実行
    .Delete                                             ' -> 閉局
    End With
End Sub

.TextFileTabDelimiter = True

Public Sub ReadCSVByFSO()
    Dim fso As FileSystemObject
    Dim lineList As mscorlib.ArrayList
    Dim wsf As WorksheetFunction
    Dim filePath As String

    ' 各クラスのインスタンスを生成
    Set fso = New FileSystemObject                      ' -> CSV抽出用
    Set lineList = New ArrayList                        ' -> 抽出結果格納用
    Set wsf = Application.WorksheetFunction             ' -> Excel関数

    filePath = "[anyPath]"                              ' -> CSVファイルパス
    With fso.OpenTextFile(filePath)                     ' -> ファイル展開
    ' 各行をカンマで分割してリストに格納
    Do Until .AtEndOfStream                             ' -> 最終行までループ
        lineList.Add Split(.ReadLine, ",")              ' -> 1行ずつ読む
    Loop
    .Close                                              ' -> 閉じる
    End With

    ' 配列を変換
    csvLines = lineList.ToArray                         ' -> リスト配列化
    csvLines = wsf.Transpose(csvLines)                  ' -> 二次元配列化
    csvLines = wsf.Transpose(csvLines)                  ' -> 次元転換

    ' 抽出結果を出力
    With ThisWorkbook.Worksheets("[sheetIndex]")
    .Range( _
        .Cells(1, 1), _
        .Cells(UBound(csvLines), UBound(csvLines, 2)) _
    ).Value = csvLines
    .Columns.AutoFit
    End With
End Sub

Public Sub ReadCSVByADORecordset()
    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim filePath As String, folderPath As String
    Dim csvName As String, strSQL As String

    filePath = "[anyPath]"                              ' ファイルパス
    csvName = Dir(filePath)                             ' ファイル名
    folderPath = Replace(filePath, csvName, "")         ' フォルダパス

    ' CSV抽出用SQL
    strSQL = vbNullString
    strSQL = strSQL & "SELECT *"
    strSQL = strSQL & "  FROM [" & csvName & "]"

    ' コネクションオブジェクトを設定
    Set con = New Connection
    With con
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Properties("Extended Properties").Value = "Text;HDR=Yes;FMT=Delimited"
    .Open folderPath
    End With
    ' 抽出を実行
    Set rs = New Recordset
    rs.Open strSQL, con, adOpenStatic, adLockReadOnly

    ' 結果出力
    With ThisWorkbook.Worksheets("[sheetIndex]")
    For Each f In rs.Fields                             ' -> 列名を出力
        ixCol = ixCol + 1
        .Cells(1, ixCol).Value = f.Name
    Next
    .Range("A2").CopyFromRecordset rs                   ' -> 値を出力
    .Columns.AutoFit
    End With
End Sub

Public Const CHARSET_SJIS As String = "Shift_JIS"
Public Const CHARSET_UTF8 As String = "UTF-8"

Public Sub ReadCSVByADODBStream()
    Dim adoStream As ADODB.Stream
    Dim lineList As mscorlib.ArrayList
    Dim wsf As WorksheetFunction
    Dim filePath As String

    ' 各インスタンス生成
    Set adoStream = New Stream                          ' -> ADODB.Stream
    Set lineList = New ArrayList                        ' -> 抽出結果格納用
    Set wsf = Application.WorksheetFunction             ' -> Excel関数
    filePath = "[anyPath]"                              ' -> CSVファイルパス

    ' CSV読み込み処理
    With adoStream
    .Charset = CHARSET_SJIS                             ' -> 文字コード設定
    .LineSeparator = adLF                               ' -> 改行コード設定
    .Open
    .LoadFromFile fileName:=filePath                    ' -> 読み込み対象
    Do Until .EOS                                       ' -> 最終行までループ
        textLine = Split(.ReadText(adReadLine), ",")    ' -> 1行ずつ読み込む
        lineList.Add textLine                           ' -> リストへ追加
    Loop
    .Close
    End With

    ' 配列を変換
    csvLines = lineList.ToArray                         ' -> 配列化
    csvLines = wsf.Transpose(csvLines)                  ' -> 二次元配列化
    csvLines = wsf.Transpose(csvLines)                  ' -> 次元転換

    ' 抽出結果を出力
    With ThisWorkbook.Worksheets("[sheetIndex]")
    .Range( _
        .Cells(1, 1), _
        .Cells(UBound(csvLines), UBound(csvLines, 2)) _
    ).Value = csvLines
    .Columns.AutoFit
    End With
End Sub