【VBA関数】テキストファイル保存（UTF8）

長年お世話になってきたVB6やVB.NETの膨大なコードをVBA用に移植してく記事ですよ。今回は、VBAでテキストファイルを保存する際に使える、UTF-8（BOMなし）形式でのテキストファイル保存関数を紹介します。

なお、変数はほとんど"v"で始めるなど、常識的ではない部分も多いのでご利用の際はご注意ください。

マクロで直接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

もっとも、VB6では文字形式なんて気にするまでもなくANSI一択だったので、今回のコードはほぼ書き直したんですけどね。

次回は、保存したテキストファイルを開く方法を紹介します。