Excel VBAでCSVファイルをUTF-8 BOMなし出力

やりたかったこと

CSVファイルをインプットにテーブル登録しなければいけなく、面倒なのでVBAである程度自動化しました。1シート程度だったらば、毎回ファイル形式を指定して保存するのですが、4ファイルをヘッダ行など編集しながら作成するのには辟易としていました。
文字コードはSAPシステムでお決まりのUTF-8のBOMなしです。Excel2013で動かしました。
備忘録として投稿です。

事前設定

事前設定が必要です。「エクセルのマクロ（VBA）でUTF-8を書き出す方法」の記事を参照ください。

機能

1. CSVファイル出力

Excel上のボタン押下で動かしました。親プログラムでここから子関数を呼び出します。

WriteCSV.bas

Sub WriteCSV()
'
' WriteCSV Macro
'

'
    Call WriteCsvFile(2, 25, "C:\TestData\Data\ZCCMI0210_FK_BP.csv")
    Call WriteCsvFile(3, 122, "C:\TestData\Data\ZCCMI0250_FK_CONT.csv")
    Call WriteCsvFile(4, 28, "C:\TestData\Data\ZCCMI0190_FK_INST.csv")
    Call WriteCsvFile(5, 24, "C:\TestData\Data\ZCCMI0200_FK_FACT.csv")

    MsgBox "CSV File Saved!"


End Sub

2. 実際にファイル出力

WriteCSVFile.bas

Private Sub WriteCsvFile(wsId As Integer, endRow As Integer, csvFileName As String)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsId)

    'Create ADODB.Stream Object
    Dim adoSt As Object
    Set adoSt = CreateObject("ADODB.Stream")

    Dim strLine As String
    Dim i As Long, j As Long

    i = 2

    With adoSt
        .charSet = "UTF-8"
        .LineSeparator = adLF
        .Open

        Do While ws.Cells(i, 1).Value <> ""


            strLine = """"
            For j = 1 To endRow

                strLine = strLine & ws.Cells(i, j).Value & ""","""

            Next

            strLine = strLine & ws.Cells(i, j).Value & """"


            .WriteText strLine, adWriteLine

            i = i + 1

        Loop

'      フッタ を追記
       .WriteText "8", adWriteLine


'       BOM削除
        .Position = 0
        .Type = adTypeBinary

        .Position = 3

        Dim byteData() As Byte
        byteData = .Read

        .Close

        .Open
        .Write byteData


        .SaveToFile csvFileName, adSaveCreateOverWrite
        .Close

    End With

End Sub

感想

プロジェクトでいくつかあると便利かと思います(特に人の出入りが激しく、どんなデータを作ればどんなテストケースを充足できるか整理できていない場合)。VBAなんて今までほとんど使ったことがないので、ツッコミどころ満載のしょぼいコードです。