【Excel VBA】 Excel マクロ ~ ファイル出力 / UTF-8 ~

■ はじめに

* Excel VBA で、UTF-8形式でファイル保存する方法を記す 

 ■ サンプル

Sub ボタン1_Click()
    If SaveFileWithUtf8("Hello World!", "helloWorld.txt") Then
        MsgBox "ファイル作成に成功しました", vbCritical & vbOKOnly, "成功"
    Else
        MsgBox "ファイルの作成に失敗しました", vbCritical & vbOKOnly, "エラー"
    End If
End Sub

Public Function SaveFileWithUtf8(ByVal inputData As String, ByVal fileName As String) As Boolean
On Error GoTo ErrorHandler
    Dim isSuccessful As Boolean: isSuccessful = False
    
    ' 定数
    Const AdodbTypeBinary As Integer = 1
    Const AdodbTypeText As Integer = 2
    Const AdodbSaveCreateOverWrite As Integer = 2
    Const FileCharset As String = "UTF-8"
    
    ' ADODB.Streamを作成
    Dim sourceOfDataStream: Set sourceOfDataStream = CreateObject("ADODB.Stream")
    ' 最初はテキストモードでUTF-8で書き込む
    sourceOfDataStream.Type = AdodbTypeText
    sourceOfDataStream.Charset = FileCharset
    sourceOfDataStream.Open
    
    ' ファイルに書き込み
    sourceOfDataStream.WriteText (inputData), 1
    
    ' バイナリモードにするためにPositionを0に戻す
    ' Readするためにはバイナリタイプでないといけない
    sourceOfDataStream.Position = 0
    sourceOfDataStream.Type = AdodbTypeBinary
    ' Positionを3にしてから読み込むことで最初の3バイトをスキップする
    ' UTF-8(BOMあり)のBOMをスキップします
    sourceOfDataStream.Position = 3
    Dim binaryOutputData: binaryOutputData = sourceOfDataStream.Read()
    
    ' 読み込んだバイナリデータをバイナリデータとしてファイルに出力する
    Dim outputStream: Set outputStream = CreateObject("ADODB.Stream")
    outputStream.Type = AdodbTypeBinary
    outputStream.Open
    outputStream.Write (binaryOutputData)
    outputStream.SaveToFile fileName, AdodbSaveCreateOverWrite
    
    isSuccessful = True
    GoTo Finally
ErrorHandler:
    isSuccessful = False
Finally:
    'ストリームの後始末
    If Not outputStream Is Nothing Then
        outputStream.Close
    End If
    If Not sourceOfDataStream Is Nothing Then
        sourceOfDataStream.Close
    End If
    
    SaveFileWithUtf8 = isSuccessful
End Function

 関連記事

Excel マクロ ~ 入門編 ~
https://dk521123.hatenablog.com/entry/2015/07/15/104500