【エクセル】VBAマクロを使ってシートの内容をCSVファイル（UTF-8 BOMなし）で書き出す

Sub ExportToCSV()
    Dim sheet As Worksheet
    Set sheet = ThisWorkbook.Sheets("シート名")
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\ファイル名.csv"

    Dim csvText As String
    Dim row As Long, col As Long
    For row = 1 To sheet.UsedRange.Rows.Count
        '空行のチェック：行内のセルすべてが空であれば書き出しをスキップ
        Dim isEmptyRow As Boolean
        isEmptyRow = True
        For col = 1 To sheet.UsedRange.Columns.Count
            If sheet.Cells(row, col).Value <> "" Then
                isEmptyRow = False
                Exit For
            End If
        Next col
        If Not isEmptyRow Then
            For col = 1 To sheet.UsedRange.Columns.Count
                csvText = csvText & sheet.Cells(row, col).Value & ","
            Next col
            csvText = Left(csvText, Len(csvText) - 1) & vbCrLf
        End If
    Next row
    csvText = Left(csvText, Len(csvText) - 2)

    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Charset = "UTF-8"
        .LineSeparator = -1 'adCRLF
        .Open
        .WriteText csvText
        'バイナリ変換するためにPositionを0にする
        .Position = 0
        'Typeを変更してバイナリ変換
        .Type = 1 'adTypeBinary
        'Positionを再設定してBOMデータが格納されている最初の3バイトをスキップ
        .Position = 3
        'バイナリデータとして一時保存
        Dim byteData() As Byte
        byteData = .Read
        .Close
        
        .Open
        .Write byteData
        .SaveToFile filePath, 2 'adSaveCreateOverWrite
        .Close
    End With
    MsgBox "書き出しが完了しました。"
End Sub