ExcelVBAでシートの内容をUTF-8,LFのCSVファイルに出力したい

ExcelVBAで、シートの内容をUTF-8,LFのCSVファイルに書き出したかったのでメモです。
UTF-8の場合は、ADODBを使う必要があるそうです。
また、BOMなしのUTF-8とする場合にはひと手間必要でした。

実行環境

バージョン 2008 (ビルド 13127.20408 クイック実行)

ソースコード

ファイルパスは、「ボタン1」を設置したシートの「C6」セルに入力させることを想定しています。

Option Explicit

Sub ボタン1_Click()
    Dim targetPath As String
    
    ' ファイル出力先(1シート目に入力欄ありの想定)
    targetPath = ActiveWorkbook.Worksheets(1).Cells(2, 3).Value
    
    ' データシートから値を読み込んでファイル出力
    ' 2シート目 A,B列に値が入る想定
    Call export_file(ActiveWorkbook.Worksheets(2), targetPath)
    
    Debug.Print "End"

End Sub

Sub export_file(targetWorksheet, targetPath)
    Dim maxRowNum As Long
    Dim targetRange As Range
    Dim i As Long
    Dim sheetName As String
    Dim fw As Variant
    Dim byteData() As Byte

    sheetName = targetWorksheet.Name

    ' 最下行の行番号を取得
    maxRowNum = getMaxRowNum(targetWorksheet)
    
    Set fw = CreateObject("ADODB.Stream")
    fw.Charset = "UTF-8"
    fw.Open
    
    ' ファイル出力対象範囲を決定
    Set targetRange = targetWorksheet.Range("A1:B" & maxRowNum)
    
    ' A1B1A2B2...の順で走査
    For i = 1 To targetRange.Count
        
        ' B列を処理後に改行コードを付与
        If i Mod 2 = 0 Then
            fw.WriteText targetRange.Item(i) & vbLf, 0
        Else
            fw.WriteText targetRange.Item(i) & ",", 0
        End If
        
    Next
    
    ' BOMなしUTF8作成のための作業
    fw.Position = 0
    ' adTypeBinary = 1
    fw.Type = 1
    fw.Position = 3

    byteData = fw.Read
    fw.Close

    fw.Open
    fw.Write byteData
    fw.SaveToFile targetPath & "\" & sheetName & ".csv", 2
    fw.Close
    
    Set fw = Nothing
    Set targetRange = Nothing

End Sub

' A列の最下行番号を取得する
Function getMaxRowNum(targetWorksheet)
    Dim maxRowNum As Long
    
    maxRowNum = targetWorksheet.Cells(Rows.Count, 1).End(xlUp).Row

    getMaxRowNum = maxRowNum
End Function