Excel VBA で UTF-8 エンコーディングの CSV ファイルを出力するサンプル

SaveAsCSV.bas

Option Explicit

Sub SaveAsCSV()

    '==============================
    ' 使用しているデータ範囲の取得
    '==============================

    Dim maxRow As Long
    Dim maxCol As Long

    With ActiveSheet.UsedRange
        maxRow = .Row + .Rows.Count - 1
        maxCol = .Column + .Columns.Count - 1
    End With

    '==============================
    ' ストリームの準備
    '==============================

    Dim outStream As ADODB.Stream
    Set outStream = New ADODB.Stream

    'エンコーディングを指定
    With outStream
        .Type = adTypeText
        .Charset = "UTF-8"
        .LineSeparator = adLF
    End With

    outStream.Open

    '==============================
    ' ストリームにデータを流し込む
    '==============================

    Dim r As Long
    Dim c As Long
    Dim line As String
    
    '1 行ずつ処理
    For r = 1 To maxRow

        '1 列目はカンマなし
        line = ActiveSheet.Cells(r, 1)
        
        '2 列目以降
        For c = 2 To maxCol
            line = line & "," & ActiveSheet.Cells(r, c)
        Next
        
        'r 行目のデータを Stream に出力
        outStream.WriteText line, adWriteLine
    Next

    '==============================
    ' 先頭の BOM を削除
    '==============================
    
    'BOM の分 3 バイトをスキップ
    outStream.Position = 0
    outStream.Type = adTypeBinary
    outStream.Position = 3

    'コピー用のストリーム
    Dim csvStream As ADODB.Stream
    Set csvStream = New ADODB.Stream

    'バイナリモードで開く
    csvStream.Type = adTypeBinary
    csvStream.Open

    'BOM の後からデータをコピー
    outStream.CopyTo csvStream

    '==============================
    ' ストリームのデータを書き出す
    '==============================

    Dim fileName As String
    fileName = ActiveSheet.Name & ".csv"

    'ファイルに保存
    csvStream.SaveToFile fileName, adSaveCreateOverWrite

    'ストリームの後始末
    csvStream.Close
    outStream.Close

End Sub