テキストファイルの読み込み(一行づつ)

2024.08.04

テキストファイルを一行づつ読み込み、指定したセル以下に出力していきます。
一行読み込みセルに出力し、次の行を読み込み、下のセルに出力を繰り返します。
２つの関数を載せていますが、結果は一緒です。

【サンプルプログラム】

Sub TextFileRead()
    Dim NewWb As Workbook
    Dim NewWs As Worksheet

    ' Bookを作成
    Set NewWb = Workbooks.Add
    ' Sheetを取得
    Set NewWs = NewWb.Sheets(1)

    TextFileReadToCells_SJIS "C:\ExcelVBA\テキスト.txt", NewWs, "A1"
    TextFileReadToCells "C:\ExcelVBA\テキスト_UTF8.txt", NewWs, "B1", "UTF-8"
End Sub

【関数化】- Shift-JIS

' ------------------------------------------------------------
' 説明：テキストファイルを読み込み指定したセル以下にセットする(Shift-JIS)
' 引数：1:読み込むファイル名
'       2:出力先のWorksheet
'       3:出力先のセルRange
' 戻値：読み込んだテキスト文字
' ------------------------------------------------------------
Function TextFileReadToCells_SJIS(filename As String, ws As Worksheet, Optional rng As String = "A1") As Boolean

    Dim str_buf As String
    Dim ifile As Integer
    Dim r As Long
    Dim c As Long
    
    If IsFileExists(filename) = False Then
        MsgBox "ファイルがありません"
        TextFileReadToCells_SJIS = False
        Exit Function
    End If
    
    ' 空いているファイル番号を取得
    ifile = FreeFile

    'ファイルを開く
    Open filename For Input As #ifile
    
    ' 出力先
    r = ws.Range(rng).Row
    c = ws.Range(rng).Column
    
    ' 最終行まで読み込む
    Do Until EOF(1)
        Line Input #ifile, str_buf
        
        ws.Cells(r, c) = str_buf
        r = r + 1
    Loop

    Close #ifile
    
    TextFileReadToCells_SJIS = True

End Function

【関数化】- 文字コード指定

' ------------------------------------------------------------
' 説明：テキストファイルを読み込み指定したセル以下にセットする
' 引数：1:読み込むファイル名
'       2:出力先のWorksheet
'       3:出力先のセルRange
'       4:文字コード(初期値はShift-JIS)
' 戻値：読み込んだテキスト文字
' 補足：文字コード
'       UTF-8 (BOM あり/なし) = "UTF-8"
'       UTF-16LE (BOM あり/なし) = "UTF-16"
'       UTF-16BE (BOM あり) = "UTF-16"  ※BOMなしは文字化けする
' ------------------------------------------------------------
Function TextFileReadToCells(filename As String, ws As Worksheet, Optional rng As String = "A1", Optional charcode As String = "SHIFT_JIS") As Boolean

    Dim str_buf As String
    Dim r As Long
    Dim c As Long
    
    If IsFileExists(filename) = False Then
        MsgBox "ファイルがありません"
        TextFileReadToCells = False
        Exit Function
    End If
        
    ' 出力先
    r = ws.Range(rng).Row
    c = ws.Range(rng).Column
    
    With CreateObject("ADODB.Stream")
        .Charset = charcode
        .Open
        ' オブジェクトの行区切り記号として使用される文字を指定
        .LineSeparator = -1     ' adCR:13, adCRLF:-1, adLF:10 から選択
        .LoadFromFile filename
        
        '1行毎に処理
        Do Until .EOS
            str_buf = .ReadText(-2) ' 1行取り出す adReadLine:-2
            ws.Cells(r, c) = str_buf
            r = r + 1
        Loop
        
        .Close
    End With

    TextFileReadToCells = True
    
End Function

以下の関数を使用していますので、リンクから関数をコピーします。
・ファイルの有無を確認する IsFileExists()

コメント