Excel VBA 输出CSV文件 （UTF-8格式，无BOM）

本页代码用于输出CSV文件，文件格式为UTF-8，无BOM

Sub CSV()说明

Sub CSV() 相当于Main函数，用于调用后面的Sub writeCSV_UTF8()
需要注意，这个函数会将标签设置为黄色的Sheet输出出来
这个函数为了控制CSV输出格式，可以调整输出文件的数据列是否有双引号（用于区分文字列和数值）
具体的设置为当前活动页的Cells(1, "G")里面的值
如果Cells(1, "G")里面的值为"あり"或者"なし"，就是输出的所有数据都加或者不加双引号
如果如果Cells(1, "G")里面的值为"-"或者空白，则会根据被标黄的数据Sheet里面第2行每一列所设定的"あり"或者"なし"来进行个别设置

Public Sub CSV()
    Dim flg As Boolean
    flg = False
    For Each printsheetname In ThisWorkbook.Worksheets
        'シート色が黄色の場合、CSVファイルを作成する
        If printsheetname.Tab.Color = RGB(255, 255, 0) Then
            flg = True
            Call writeCSV_UTF8(printsheetname.Name, ThisWorkbook.ActiveSheet.Cells(1, "G"))
        End If
    Next

    If flg = True Then
        MsgBox ("CSV OutPut OK")
    Else
        MsgBox ("No CSV Sheet")
    End If
End Sub

1. flg用于检测是否有文件输出，并用于最后的MsgBox的判断条件，如文件执行函数被执行，则为True，否则则为false

Sub writeCSV_UTF8()说明

Sub writeCSV_UTF8()是输出的主逻辑，用于实际生成文件
wQuoteKey可以自动设置。如果传进来值为空，则默认为"-"
这个函数制作复杂，主要是为了进行UTF-8格式和BOM的删除
输出的CSV文件，名字由一个主名字和副名字组合而成，主名字放在被激活的页面的Cells(1, "I")格子里，输出的所有文件都会有这部分的文件名，副名字为每个Sheet的标签名

Private Sub writeCSV_UTF8(wsn As String, Optional wQuoteKey As String = "-")
    Dim wQuote As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(wsn)
    
    Dim csvFile As String
    csvFile = ThisWorkbook.Path & "\" & ThisWorkbook.ActiveSheet.Cells(1, "I") & wsn & ".csv"
    
    'ADODB.Streamオブジェクトを生成
    Dim adoSt As Object
    Set adoSt = CreateObject("ADODB.Stream")
    
    Dim strLine As String
    Dim i As Long, j As Long
    Dim strRow As Integer
    strRow = 3
    i = strRow
    
    '対象シートの1列目の最終行を取得
    Dim csvLastRow As Long
    csvLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    '対象シートの3行目の最終列を取得
    Dim csvLastCol As Long
    csvLastCol = ws.Cells(strRow, ws.Columns.Count).End(xlToLeft).Column
    
    With adoSt
        .Charset = "UTF-8"
'        .LineSeparator = 10 'adLF
        .LineSeparator = -1 'adCRLF
'        .LineSeparator = 13 'adCR
        .Open
    
'        Do While ws.Cells(i, 1).Value <> ""
        Do While i <= csvLastRow
    
            strLine = ""
    
            j = 1
'            Do While ws.Cells(i, j + 1).Value <> ""
            Do While j < csvLastCol
                If wQuoteKey = "-" Then
                    wQuote = ws.Cells(2, j).Value
                Else
                    wQuote = wQuoteKey
                End If
                'タイトル行処理、必ずタイトル行にダブルクオートを付けさせるため
                If i = strRow Then wQuote = "あり"
                Select Case wQuote
                    Case "なし"
                        strLine = strLine & ws.Cells(i, j).Value & ","
                    Case Else
                        strLine = strLine & """" & ws.Cells(i, j).Value & ""","
                End Select
                j = j + 1
            Loop
            '最終列処理（「,」を付けないため）
            If wQuoteKey = "-" Then
                wQuote = ws.Cells(2, j).Value
            Else
                wQuote = wQuoteKey
            End If
            'タイトル行処理、必ずタイトル行にダブルクオートを付けさせるため
            If i = strRow Then wQuote = "あり"
            Select Case wQuote
                Case "なし"
                    strLine = strLine & ws.Cells(i, j).Value
                Case Else
                    strLine = strLine & """" & ws.Cells(i, j).Value & """"
            End Select
'            .WriteText strLine, adWriteLine
            .WriteText strLine, 1 'adWriteLine
    
            i = i + 1
    
        Loop
    
        .Position = 0 'ストリームの位置を0にする
        .Type = 1 'adTypeBinary 'データの種類をバイナリデータに変更
'        .Type = 2 'adTypeText 'データの種類をテキスト データを表します。
        .Position = 3 'ストリームの位置を3にする
    
        Dim byteData() As Byte '一時格納用
        byteData = .Read 'ストリームの内容を一時格納用変数に保存
        .Close '一旦ストリームを閉じる（リセット）
    
        .Open 'ストリームを開く
        .Write byteData 'ストリームに一時格納したデータを流し込む
'        .SaveToFile csvFile, 1 'adSaveCreateNotExist
        .SaveToFile csvFile, 2 'adSaveCreateOverWrite
        .Close
    
    End With

End Sub

1. wsn 为传入的Sheet名字，用于识别正在制作中的Sheet以及输出的CSV文件名的做成
2. Optional 为关键字，用于默认值赋予，使用此关键字之后，对函数传入的参数进行默认值的赋予
3. wQuoteKey 传入的值，用于控制双引号的有无
4. csvFile 用于制作最后输出的文件名以及文件路径
5. strRow 为数据开始行的位置，第一行用于备注或者说明，第2行是"あり","なし"文本，用于双引号的控制，第三行开始才是数据行，即：做成的CSV文件从列名开始写，列名需要从第3行开始写
6. LineSeparator 用于控制输出文件的换行格式
7. csvLastRow 用于获取CSV文件的最终列，用于控制CSV文件的最终列数

补充：wsn传入的是Sheet名字，并没有什么多余的意义，也可以在这里直接传入执行的Sheet对象