readList1.cls

'************************
'**定数
'************************
'シート名
Public Const sheet_list = "抽出リスト"
'項目数
Public Const COLUMN_MAX1 = 50   '元データのカラム数
'その他
Public Const CharSet = "UTF-16" 'リードストリーム用文字コード
Public Const ls = -1    '同じく改行コード LF(10)/CRLF(-1)

'************************
'**ファイル入出力
'************************
'パターン1 データ数&項目数がわかっている場合
'       readList(ファイルパス, カラム(項目)数
Function readList(ByRef filePath As String, ByRef colMax As Integer) As Boolean
    Dim buf As String   '読み込みバッファ
    Dim tmp As Variant    '元データの区切り文字除去

    Dim dataArry() As String    'データ格納配列

    Dim L_col As Long   'フィールド位置
    Dim L_row As Long   'レコード位置

    Dim lastRow As Long '最終行位置
    Dim fso As Object   '最終行取得用

    '正常 = true
    '異常 = false
    readList = True

    On Error GoTo ErrHdl

    'インプットファイルの最終行(データ数)取得
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso.OpenTextFile(filePath, 8)
        lastRow = .Line
        .Close
    End With
    Set fso = Nothing

    '2次元配列再宣言
    ReDim dataArry(lastRow, colMax)

    'ファイル読み込み開始
    With CreateObject("ADODB.Stream")
        .CharSet = CharSet
        .LineSeparator = ls
        .Open
        .LoadFromFile(filePath)

        L_row = 0   '初期化
        '1行ずつ書き込んでた名残でこの書き方だけど
        '最終行がわかってるからforでもなんでもええと思う
        Do Until .EOS   'end of systemだっけか？EOFとは違うっポイ あんまり調べてない
            buf = ReadText(-2)

            '区切り文字除去後配列に格納
            'これなんでvariant型にしたのか定かじゃないけど
            '一括で入れるときにvariantじゃないと入らなかったんじゃないかな確か
            tmp = Split(buf, ",")
            '読み込みデータを2次元配列に格納
            L_col = 0   '初期化
            Do Until L_col = colMax
                dataArry(L_row, L_col) = tmp(L_col)
                L_col = L_col + 1
            Loop
            L_row = L_row + 1
        Loop
        .Close
    End With
    'シート指定、転記範囲指定して一括転記
    ThisWorkbook.Worksheets(sheet_list).Range("A1:Q" & L_row + 1) = dataArry
    'メモリ解放
    Erase dataArry
    
    Exit Function

ErrHdl:
    readList = False
End Function