【Excel VBA】CSVファイルをUTF-8で出力する方法｜文字化けを防ぐADODB.Streamの使い方

Option Explicit

Sub ExportUtf8Csv()
    Dim ws As Worksheet
    Dim stm As Object
    Dim lastRow As Long, r As Long, c As Long
    Dim csvText As String, lineText As String
    Dim cellText As String, filePath As String

    '出力元のシートを指定する
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'ブックを保存していない場合は終了する
    If ThisWorkbook.Path = "" Then
        MsgBox "先にExcelファイルを保存してください。"
        Exit Sub
    End If

    'A列の最終行を取得する（A～C列を出力）
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    '1行目から最終行までCSV文字列を作成する
    For r = 1 To lastRow
        lineText = ""

        '各行のA～C列をカンマ区切りにする
        For c = 1 To 3
            'セルの値を文字列に変換する
            cellText = CStr(ws.Cells(r, c).Value2)

            'セル内のダブルクォーテーションを二重化する
            cellText = Replace(cellText, """", """""")

            '2列目以降の前にカンマを付ける
            If c > 1 Then lineText = lineText & ","

            '値をダブルクォーテーションで囲む
            lineText = lineText & """" & cellText & """"
        Next c

        '1行分を改行付きで追加する
        csvText = csvText & lineText & vbCrLf
    Next r

    '参照設定不要の遅延バインディングでStreamを作成
    Set stm = CreateObject("ADODB.Stream")
    stm.Type = 2               '2：テキスト型
    stm.Charset = "utf-8"     'UTF-8を指定する
    stm.Open

    'CSV文字列を書き込み、既存ファイルは上書きする
    stm.WriteText csvText
    filePath = ThisWorkbook.Path & "\sample_utf8.csv"
    stm.SaveToFile filePath, 2  '2：上書き保存
    stm.Close
    Set stm = Nothing

    '保存したファイルの場所を表示する
    MsgBox "CSVを出力しました。" & vbCrLf & filePath
End Sub