VBAでテキストファイルを保存する際に使える、UTF-8（BOMなし）形式でのテキストファイル保存関数を紹介します。

　マクロによって直接Wordの文書やExcelのシートを書き換えるのではなく、見つけた問題点を書き出すためのマクロなどで活用できます。

関数：TextSaveUTF8N

Function TextSaveUTF8N(ByRef aPath As String, ByRef aFullText As String) As Boolean
'UTF-8(BOMなし)形式でテキストファイルを保存

On Error GoTo errored

Dim oStream As Object
Dim vTemp

    'オブジェクトを作成
    Set oStream = CreateObject("ADODB.Stream")

    With oStream
        '設定
        .Type = 2 '(=テキスト)
        .Charset = "UTF-8"

        'オブジェクトを開く
        Call .Open
        'テキストを書き込む
        Call .WriteText(aFullText)

        'バイナリデータを取得
        .Position = 0 '先頭へ移動して..
        .Type = 1 '..バイナリデータに変更
        .Position = 3 '3バイト飛ばして...
        vTemp = .Read '..読み取る

        '閉じる
        Call .Close
    End With

    'オブジェクトを再作成
    Set oStream = CreateObject("ADODB.Stream")

    With oStream
        '設定
        .Charset = "UTF-8"
        .LineSeparator = 10 '=adLF(行送り)
        .Type = 1 '(=バイナリデータ)

        'オブジェクトを開く
        Call .Open

        'バイナリデータを書き込む
        Call .write(vTemp)
        Call .SetEOS '(末尾指定)

        'ファイルへ保存
        Call .SaveToFile(aPath, 2) '2=上書き保存

        '閉じる
        Call .Close
    End With

    'オブジェクトを解放
    Set oStream = Nothing

    '戻り値: 成功
    TextSaveUTF8N = True
    Exit Function

errored:
'(エラー処理)
    'オブジェクトを解放
    Set oStream = Nothing
    '戻り値: 失敗
    TextSaveUTF8N = False

End Function

Excelでの使用例

以下はExcelでの使用例です。A1から始めて、A2、A3……と空白になるまでセルの内容を読み取り、test.txtに保存します。

Sub ExcelTest_TextSaveUTF8()

    '保存先を決定
    Dim vPath As String
        vPath = ".\test.txt"

    'テキスト生成(テスト用サンプル)
    Dim vFullText As String, vCurText As String, y As Long
    Do
        'セル取得
        y = y + 1
        vCurText = Range("A" & y)
        If vCurText <> "" Then
        '(値があれば)
            'テキスト追加
            vFullText = vFullText & vCurText & vbCrLf
        Else
        '(空白なら)
            vFullText = vFullText & y & "行目はありませんでした。" & vbCrLf
            'ループを抜ける
            Exit Do
        End If
    Loop

    'セーブ実行
    If TextSaveUTF8N(vPath, vFullText) = True Then
        Call MsgBox("セーブ成功！", vbOKOnly)
    Else
        Call MsgBox("セーブ失敗...", vbOKOnly)
    End If

End Sub

Wordでの使用例

次はWordでの使用例です。現在の文字数と、文書全体をtest.txtに保存します。

Sub WordTest_TextSaveUTF8N()

    '保存先を決定
    Dim vPath As String
    vPath = ".\test.txt"

    'テキスト生成(テスト用サンプル)
    Dim vFullText As String
    vFullText = "総文字数=" & ThisDocument.Characters.Count & vbCrLf
    vFullText = vFullText & "--------" & vbCrLf
    vFullText = vFullText & ThisDocument.Range(0).Text

    'セーブ実行
    If TextSaveUTF8N(vPath, vFullText) = True Then
        Call MsgBox("セーブ成功！", vbOKOnly)
    Else
        Call MsgBox("セーブ失敗...", vbOKOnly)
    End If

End Sub

次回は、保存したテキストファイルを開くマクロを紹介します！

【VBA】ファイルを開く（拡張子参照）

プログラム・IT

▼