VBAでテキストファイルを読み込み／書き込み

EXCEL Microsoft ADO UTF-8 Shift-JIS VBA


VBAでテキストファイルを読んだり書いたりするために、マクロを作成。



かなり参考にさせていただいたサイト

  [Excel]Excel VBAでUTF-8のテキストファイルを扱う(ADODB.Stream)Add Star

１．テキストを読み込む



テキストファイルをStringまたはString配列で読み込みます。

Private Function readText(fullFileName As String, Optional outputType = 1, Optional charcode = 0)
'-----------------------------------------------
' readText
' 引数の情報でテキストファイルを読み込む
' 使用注：VBAでMicrosoftADOの参照設定が必要
'
' 引数１：fullFileName String    ファイルパス
' 引数２：outputType String     出力タイプ(省略可、デフォルト1)
'                                 0:String型
'                                 1:String()型
' 引数３：charcode long         文字コード(省略可、デフォルト0)
'                                 0:Shift-JIS
'                                 1:UTF-8
'
'-----------------------------------------------

    Dim str As String
    Dim strArr() As String
    ReDim Preserve strArr(0) As String

    'Streamオブジェクト作成
    Dim fObj As Object
    Set fObj = CreateObject("ADODB.Stream")

    'オブジェクトに保存するデータの種類を文字列型に指定する
    fObj.Type = adTypeText

    '文字列型のオブジェクトの文字コードを指定する
    If charcode = 0 Then
        fObj.charset = "Shift-JIS"
    Else
        fObj.charset = "UTF-8"
    End If

    'オブジェクトのインスタンスを作成
    fObj.Open

    'ファイルからデータを読み込む
    fObj.LoadFromFile (fullFileName)

    If outputType = 1 Then
        '最終行までループする
        Do While Not fObj.EOS
            '次の行を読み取る
            strArr(UBound(strArr)) = fObj.readText(adReadLine)
            ReDim Preserve strArr(UBound(strArr) + 1) As String
        Loop

    Else
        str = fObj.readText(adReadAll)
    End If

    'オブジェクトを閉じる
    fObj.Close

    'メモリからオブジェクトを削除する
    Set fObj = Nothing

    If outputType = 1 Then
        readText = strArr
    Else
        readText = str
    End If

End Function


第1引数にフルパスのファイル名

第2引数には返却する型

第3引数にはファイルの文字コードを指定できます。(Shit-JIS／UTF-8)

行単位で処理したい時はString()で返却する様にしますね。

２．テキストを書き込む（文字列型）



Stringのデータをテキストファイルに書き込みます。

Private Sub writeText(fullFileName As String, text As String, Optional overWriteClass = 1, Optional charcode = 0)
'-----------------------------------------------
' writeText
' 引数の情報でテキストファイルへ書き込む
' 使用注：VBAでMicrosoftADOの参照設定が必要
'
' 引数１：fullFileName String    ファイルパス
' 引数２：text String            書き込みテキスト（改行可）
' 引数３：overWriteClass long     上書き区分(省略可、デフォルト1)
'                                 0:上書きしない
'                                 1:上書きする(ファイルない場合新規作成）
'                                 2:追記する(ファイルない場合新規作成）
' 引数４：charcode long         文字コード(省略可、デフォルト0)
'                                 0:Shift-JIS
'                                 1:UTF-8
'
'-----------------------------------------------

    Dim wText As String

    'Streamオブジェクト作成
    Dim fObj As Object
    Set fObj = CreateObject("ADODB.Stream")

    'オブジェクトに保存するデータの種類を文字列型に指定する
    fObj.Type = adTypeText

    '文字列型のオブジェクトの文字コードを指定する
    If charcode = 0 Then
        fObj.charset = "Shift-JIS"
    Else
        fObj.charset = "UTF-8"
    End If

    '出力タイプ2:追記の場合、既存テキストを読み込む
    If overWriteClass = 2 Then
        'ファイルない場合、エラーを無視する
        On Error GoTo Err1
        wText = readText(fullFileName, 0, charcode) + vbCrLf + text

    Else

Err1:
        wText = text
    End If

    'オブジェクトのインスタンスを作成
    fObj.Open

    'テキストをオブジェクトに書き込む
    fObj.writeText wText, adWriteAll

    'オブジェクトの内容をファイルに保存
    If overWriteClass = 1 Or overWriteClass = 2 Then
        fObj.SaveToFile (fullFileName), adSaveCreateOverWrite

    Else
        fObj.SaveToFile (fullFileName), adSaveCreateNotExist

    End If

    'オブジェクトを閉じる
    fObj.Close

    'メモリからオブジェクトを削除する
    Set fObj = Nothing

End Sub

３．テキストを書き込む（文字配列型）



項番２のwriteText()を使用して

String配列のデータをテキストファイルに書き込みます。

Private Sub writeTextByStrArr(fullFileName As String, text() As String, Optional overWriteClass = 1, Optional charcode = 0)
'-----------------------------------------------
' writeTextByStrArr
' writeText()を使用してStrArr型の文字列をテキストファイルへ書き込む
' 使用注：VBAでMicrosoftADOの参照設定が必要
'
' 引数１：fullFileName String    ファイルパス
' 引数２：text() String            書き込みテキスト
' 引数３：overWriteClass long     上書き区分(省略可、デフォルト1)
'                                 0:上書きしない
'                                 1:上書きする(ファイルない場合新規作成）
'                                 2:追記する(ファイルない場合新規作成）
' 引数４：charcode long         文字コード(省略可、デフォルト0)
'                                 0:Shift-JIS
'                                 1:UTF-8
'
'-----------------------------------------------
    Dim wStr As String
    Dim x As Long
    
    For x = 0 To UBound(text) - 1
        wStr = wStr + text(x) + vbCrLf
    Next x
    
    '最終行は改行追加しない
    wStr = wStr + text(x)
    
    Call writeText(fullFileName, wStr, overWriteClass, charcode)
    
End Sub

MicrosoftADOの参照設定



今回作成したマクロではVBAで[Microsoft ActiveX Data Objects]の参照設定が必要。

以下の通り。



2014.6.13 訂正

上記のwriteTextByStrArr()に誤りがあり、
以下のコードを削除しました。
参照していた方、申し訳ありません。


＞    '最終行は改行追加しない
＞    x = x + 1
＞    wStr = wStr + text(x)