VBAでUTF8(BOMなし)のファイルを出力する関数

関数名
- WriteToUTF8NoBomFile
処理概要
- UTF8(BOMなし)のファイルを出力する。
入力
- 出力先パス: OutputPath、
- 出力データ: OutputLines()
  - 配列で与える。
  - 1要素が1行に対応する。
入力(オプショナル)
- 改行コード: LineSeparator
  - CRLF or LF。デフォルトはLF。
- 上書きオプション: OverWrite
  - デフォルトはTrue
処理の説明
- BOMありのUTF8のストリームを作成し、3バイト(BOMの部分)を削ったものをBOMなしのUTF8のファイルとして出力する。
作成動機
- 検索すると色々コードが上がっているが、自分にとって使いやすいものがなかった。
- まるっと忘れたときに、すぐ使える形で残しておくため。
参考サイト
- Stackoverflow
  - このコードは、上記のものをちょっと変えたもの。
コード
- UTF8(BOMなし)のファイルを出力する関数

Sub WriteToUTF8NoBomFile(ByRef OutputPath As String, ByRef OutputLines() As String, _
                        Optional InLineSeparator As String = "LF", _
                        Optional InOverWrite As Boolean = True)

   ' ADODBの設定パラメータ
   Const SaveCreateNotExist = 1
   Const SaveCreateOverWrite = 2
   Const TypeBinary = 1
   Const TypeText = 2
   Const lineSeparatorLF = 10
   Const lineSeparatorCRLF = -1
   Const WriteLine = 1
   Const notWriteLine = 0

   Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")  ' UTF8(BOM)ありのストリーム
   Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")  ' UTF8(BOM)なしのストリーム

   Dim lineSeprator As Long  ' 改行コードを格納する変数
   Dim overWrite As Long  ' 上書きフラグを格納する変数
   Dim line As Variant  ' For Each用の一時変数

   ' 改行コードの設定
   If InLineSeparator = "CRLF" Then
      lineSeprator = lineSeparatorCRLF
   ElseIf InLineSeparator = "LF" Then
      lineSeprator = lineSeparatorLF
   Else
      MsgBox "改行コード(InLineSeparator)は CRLF か LF のみ使用可能です。"
      End
   End If

   ' 上書きするかどうかの設定
   If InOverWrite Then
      overWrite = SaveCreateOverWrite
   Else
      overWrite = SaveCreateNotExist
      If Dir(OutputPath) <> "" Then
            MsgBox "上書きしないオプションが設定されましたが、出力先パスは存在します。"
            End
      End If
   End If

   With objStreamUTF8
      .Charset = "UTF-8"
      .LineSeparator = lineSeprator
      .Open

      For Each line In OutputLines
            .WriteText line, WriteLine
      Next

      .Position = 3
   End With

   With objStreamUTF8NoBOM
      .Type = TypeBinary
      .Open
      objStreamUTF8.CopyTo objStreamUTF8NoBOM
      .SaveToFile OutputPath, overWrite
   End With

   objStreamUTF8.Close
   objStreamUTF8NoBOM.Close

End Sub

使用例

Sub TestUTF8Write()

Dim Data(1 To 3) As String
Dim i As Long
Dim Path As String

' 出力先パス作成
Path = ThisWorkbook.Path & "\" & "sample-utf8-no-bom.txt"

' 出力用テストデータ作成
For i = 1 To 3
   Data(i) = i & "行目"
Next

' UTF8(BOMなし)ファイルを出力
Call WriteToUTF8NoBomFile(Path, Data())

End Sub