マクロでCSVをUTF-8で書き出す方法は、主に2つあります。1つはExcelの保存機能に任せる SaveAs の xlCSVUTF8 です。もう1つは、CSVの文字列を自分で組み立てて ADODB.Stream で書き出す方法です。xlCSVUTF8 は手軽ですが、BOM付きで保存されます。ADODB.Stream は手間がかかる代わりに、BOMを付けるかどうかを選べます。

この記事では、2つの方法のコードと選び方を説明します。保存したファイルにBOMがあるかどうかと、行数をマクロで確認するところまで扱います。

先に決めること:取り込み先がBOM付きを受け付けるか

UTF-8のCSVには、先頭に3バイトの印(BOM:EF BB BF)が付いたものと付いていないものがあります。どちらを作るかは、CSVを渡す先の仕様で決まります。

  • Excelで開いて人が見る場合や、BOM付きで問題ない取り込み先 → xlCSVUTF8 で足ります
  • 取り込み先が「BOMなしUTF-8」を指定している場合や、1列目の列名が読めないなどの不具合が出る場合 → BOMなしで書き出します

取り込み先の仕様が分からないときは、マニュアルやヘルプで「文字コード」「UTF-8」の説明を確認してから選んでください。

比べる点 xlCSVUTF8(SaveAs) ADODB.Stream
BOM 付く 付ける・付けないを選べる
カンマ・引用符・セル内改行の扱い Excelが処理する 自分でコードを書く
書き出される値 セルの表示どおりの文字 .Value を文字列に変換したもの(表示形式は反映されない)
動く環境 xlCSVUTF8 に対応したバージョンのExcel Windows版Excel(ADODBを使うため)
向いている場面 手軽にUTF-8で書き出したい BOMなしが必須、または値の書き方を自分で決めたい

BOMなしにしたいが、引用符の処理はExcelに任せたい場合もあります。そのときは、xlCSVUTF8 で保存したあとに先頭の3バイトだけを取り除く方法が使えます(後述の方法3)。

方法1:xlCSVUTF8で保存する(BOMあり)

Option Explicit

Sub SaveSheetAsCsvUtf8()
    Dim wbOut As Workbook
    Dim outPath As String

    outPath = "C:\Work\export_" & Format(Date, "yyyymmdd") & ".csv"

    ' 書き出したいシートだけを新しいブックにコピーする
    ThisWorkbook.Worksheets("出力").Copy
    Set wbOut = ActiveWorkbook

    Application.DisplayAlerts = False   ' 上書き確認などを表示しない
    wbOut.SaveAs Filename:=outPath, FileFormat:=xlCSVUTF8
    Application.DisplayAlerts = True

    wbOut.Close SaveChanges:=False
End Sub

このコードのポイントは次の3つです。

  • シートを新しいブックにコピーしてから保存する:マクロを書いたブックをそのまま SaveAs でCSVにすると、開いているブック自体がCSVとして扱われるようになります。しかも保存されるのは、アクティブなシート1枚だけです。新しいブックに分けておけば、元のブックは変わりません。
  • 上書きに注意する:DisplayAlerts = False にすると、同じ名前のファイルがあっても確認なしで上書きされます。消したくないファイルがあるなら、保存する前に Dir(outPath) <> "" で同じ名前のファイルがあるかを調べ、あれば処理を止めてください。
  • 定数が使えるか確認する:xlCSVUTF8(値は62)は、比較的新しいExcelで追加された保存形式です。Option Explicit を付けておけば、Excelが対応していない場合に「変数が定義されていません」というエラーが出て、実行前に気付けます。VBEのオブジェクトブラウザー(F2)で xlCSVUTF8 を検索しても、定義があるか確認できます。対応していない場合は方法2を使ってください。

方法2:ADODB.StreamでBOMあり・なしを選んで書き出す

Sub ExportCsvUtf8(ByVal ws As Worksheet, ByVal outPath As String, ByVal withBom As Boolean)
    Const adTypeBinary As Long = 1
    Const adTypeText As Long = 2
    Const adCRLF As Long = -1
    Const adWriteLine As Long = 1
    Const adSaveCreateOverWrite As Long = 2

    Dim data As Variant
    Dim fields() As String
    Dim r As Long, c As Long
    Dim stm As Object, bin As Object

    data = ws.Range("A1").CurrentRegion.Value
    If Not IsArray(data) Then
        MsgBox "出力する表が見つからないか、1セルしかありません。"
        Exit Sub
    End If

    Set stm = CreateObject("ADODB.Stream")
    stm.Type = adTypeText
    stm.Charset = "UTF-8"
    stm.LineSeparator = adCRLF
    stm.Open

    For r = 1 To UBound(data, 1)
        ReDim fields(1 To UBound(data, 2))
        For c = 1 To UBound(data, 2)
            If IsError(data(r, c)) Then
                stm.Close
                MsgBox ws.Cells(r, c).Address(False, False) & " がエラー値のため、出力を中止しました。"
                Exit Sub
            End If
            fields(c) = CsvField(data(r, c))
        Next c
        stm.WriteText Join(fields, ","), adWriteLine
    Next r

    If withBom Then
        stm.SaveToFile outPath, adSaveCreateOverWrite
    Else
        ' Charset="UTF-8" で書くと先頭にBOM(3バイト)が付くため、4バイト目以降だけを保存する
        stm.Position = 0
        stm.Type = adTypeBinary
        stm.Position = 3
        Set bin = CreateObject("ADODB.Stream")
        bin.Type = adTypeBinary
        bin.Open
        stm.CopyTo bin
        bin.SaveToFile outPath, adSaveCreateOverWrite
        bin.Close
    End If
    stm.Close
End Sub

Private Function CsvField(ByVal v As Variant) As String
    Dim s As String
    If VarType(v) = vbDate Then
        s = Format(v, "yyyy/mm/dd")   ' 取り込み先の日付形式に合わせて変える
    Else
        s = CStr(v)
    End If
    ' カンマ・ダブルクォーテーション・改行を含む値だけを "" で囲む
    If InStr(s, ",") > 0 Or InStr(s, """") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Then
        s = """" & Replace(s, """", """""") & """"
    End If
    CsvField = s
End Function

Sub RunExport()
    ' 3番目の引数が False ならBOMなし、True ならBOMあり
    ExportCsvUtf8 ThisWorkbook.Worksheets("出力"), "C:\Work\export.csv", False
End Sub

このコードで押さえておきたい点は次のとおりです。

  • Charset = "UTF-8" を指定したADODB.Streamは、テキストを書き込むと先頭にBOMを付けます。BOMなしで保存するときは、ストリームをバイナリに切り替え、4バイト目以降だけを別のストリームにコピーして保存します。
  • ストリームの種類(Type)を切り替える前には、Position = 0 で読み書きの位置を先頭に戻しておく必要があります。
  • 行の区切りは、LineSeparator = adCRLF で CRLF にしています。取り込み先がLFを求める場合は、adLF(値は10)に変えてください。
  • 値にカンマ・ダブルクォーテーション・改行が含まれる場合だけ、" で囲みます。値の中の " は "" のように2つ重ねます。
  • エラー値(#N/Aなど)のセルがあると、そのセルの位置を表示して処理を止めます。エラー値を空欄として黙って書き出さないためです。
  • 書き出すのは、A1から続いている表(CurrentRegion)です。途中に空白の行や列があると、そこから先は書き出されません。

.Value を使うので、セルの表示形式は反映されません。たとえば先頭の0は、セルに「00123」が文字列で入っていれば残ります。しかし、数値の123を表示形式で「00123」に見せているだけなら、「123」と書き出されます。日付は CsvField の中で yyyy/mm/dd に固定しているので、取り込み先が求める形式に合わせて書き換えてください。

保存先は、C:\Work\... のようなローカルのフォルダを指定してください。ブックがOneDriveと同期されている場合、ThisWorkbook.Path がフォルダではなくURLを返すことがあります。その値をそのまま保存先に使うと、SaveToFile が失敗します。

方法3:xlCSVUTF8で保存してからBOMだけを外す

引用符や表示形式の処理はExcelに任せ、BOMだけを取り除く方法です。方法1で保存したあとに、次の RemoveUtf8Bom を呼び出します。

Sub RemoveUtf8Bom(ByVal path As String)
    Dim src As Object, dst As Object

    If Not HasUtf8Bom(path) Then Exit Sub   ' BOMがなければ何もしない

    Set src = CreateObject("ADODB.Stream")
    src.Type = 1   ' adTypeBinary
    src.Open
    src.LoadFromFile path
    src.Position = 3

    Set dst = CreateObject("ADODB.Stream")
    dst.Type = 1
    dst.Open
    src.CopyTo dst
    src.Close

    dst.SaveToFile path, 2   ' adSaveCreateOverWrite
    dst.Close
End Sub

先にBOMがあるかを調べているので、誤って2回実行しても、データの先頭3バイトが削られることはありません。HasUtf8Bom は次の見出しで定義しています。

保存後に確認する:BOMの有無と行数

保存したファイルが期待どおりになっているか、マクロで確認します。

Function HasUtf8Bom(ByVal path As String) As Boolean
    Dim f As Integer
    Dim b(0 To 2) As Byte

    If FileLen(path) < 3 Then Exit Function
    f = FreeFile
    Open path For Binary Access Read As #f
    Get #f, , b
    Close #f
    HasUtf8Bom = (b(0) = &HEF And b(1) = &HBB And b(2) = &HBF)
End Function

Function CountLines(ByVal path As String) As Long
    Dim stm As Object
    Dim txt As String

    Set stm = CreateObject("ADODB.Stream")
    stm.Type = 2   ' adTypeText
    stm.Charset = "UTF-8"
    stm.Open
    stm.LoadFromFile path
    txt = stm.ReadText(-1)   ' adReadAll
    stm.Close

    If Len(txt) = 0 Then Exit Function
    CountLines = Len(txt) - Len(Replace(txt, vbLf, ""))
    If Right(txt, 1) <> vbLf Then CountLines = CountLines + 1   ' 最終行に改行がない場合
End Function

Sub CheckCsv()
    Dim p As String
    p = "C:\Work\export.csv"
    Debug.Print "BOMあり: "; HasUtf8Bom(p)
    Debug.Print "CSVの行数: "; CountLines(p)
    Debug.Print "シートの行数: "; ThisWorkbook.Worksheets("出力").Range("A1").CurrentRegion.Rows.Count
End Sub

結果はイミディエイトウィンドウ(Ctrl+G)に表示されます。確認する点は次の3つです。

  1. BOM:BOMありで作ったつもりなら True、BOMなしなら False になっているか。
  2. 行数:CSVの行数がシートの行数と同じか。
  3. セル内改行がある場合:セル内の改行も1行として数えられるので、CSVの行数のほうが多くなります。この場合は、セル内改行の数をシートで数えて足してから比べます。たとえば対象が A1:F500 なら、=SUMPRODUCT(LEN(A1:F500)-LEN(SUBSTITUTE(A1:F500,CHAR(10),""))) で数えられます。

ファイルをテキストエディターで開くのも有効です。文字コード(BOMの有無)を表示できるエディターなら、マクロの結果と合っているかを目で確かめられます。このとき、確認のためにExcelでCSVを開いて上書き保存するのは避けてください。保存し直すと、文字コードや値の書き方が変わることがあります。

よくあるつまずき

  • 「書き込みできません」というエラーが出る:同じ名前のCSVがExcelなどで開かれていないか確認してください。保存先のフォルダに書き込み権限があるかも確認します。
  • 方法1で保存した数値に引用符やカンマが付く:xlCSVUTF8 はセルの表示どおりに書き出します。たとえば桁区切りの表示形式を設定した「1,234」は、引用符で囲まれた文字として書き出されます。数値のまま渡したい列は、書き出し用のシートで表示形式を「標準」に戻しておきます。
  • 方法2で先頭の0が消える・日付の形がおかしい:.Value には表示形式が反映されないためです。0を残したい列は文字列で入力しておくか、CsvField の中で Format を使って整えます。
  • Mac版Excelで方法2・方法3が動かない:Mac版ExcelではADODB.Streamを使えないため、使えるのは方法1だけです(xlCSVUTF8 に対応している場合)。
  • 取り込み先でまだ1列目の列名が読めない:HasUtf8Bom でBOMが本当に取れているかを確認してください。BOMが取れているのに読めない場合は、区切り文字や改行コード(CRLF・LF)など、取り込み先が求めるほかの条件も確認します。
おすすめの記事