<Array to CSV> 「配列」を「CSV」へ。ダブルクォーテーション有無、Shift-JIS/UTF-8選択可能。ADODB.Stream使用。

'*******
'* 二次元配列をCSVファイルに出力。20240202
'* 二次元配列専用に変更
'* https://loosecarrot.com/2020/02/15/3951/
'* arr：二次元配列。これが、csvファイルに出力される
'* FileName：csvファイル名、フルパス
'* DoubleQuotation：Trueで「""（ダブルクォーテーション）」でデータを囲う。Falseで「""（ダブルクォーテーション）」なし
'*                          省略時は、「""（ダブルクォーテーション）」なし｡
'* code：文字コードを、「UTF-8」にしたい場合は、「utf-8」（空白でなければ、どのような文字でも良い）を入れる。省略時は、「Shift_JIS」となる。
Sub array_to_csv(ByRef arr As Variant, ByVal FileName As String, _
                Optional DoubleQuotation As Boolean, _
                Optional code As String)
    Dim startRow As Long                                '読込みする開始行
    Dim endRow As Long                                  '読込みする終了行
    Dim startCol As Long                                '読込みする開始列
    Dim endCol As Long                                  '読込みする終了行
    Dim outputArray As Variant                          'csv出力するデータの配列
    Dim csvFilePath As String                           'csv出力するパス
    Dim i As Integer                                    'ループ用変数
    Dim j As Long                                       'ループ用変数
    Dim outputText As String                            '出力テキストを格納
    
    outputArray = arr
    
    startCol = 1                                        '開始列
    startRow = 1                                        '開始行
    endCol = UBound(outputArray, 2)                     '最終列
    endRow = UBound(outputArray)                        '最終行
    
    '列×行数分ループ
    For i = 1 To endRow
        For j = 1 To endCol
            
            'カンマ区切り
            
            ' i行、j列、以下のみ、""なしの整数していた
            ' すべて「"」なし。数字変換もなし
            If Not DoubleQuotation And i > 0 And j > 0 Then
                'outputText = outputText & CLng(outputArray(i, j)) & ","
                outputText = outputText & outputArray(i, j) & ","
            Else
                outputText = outputText & """" & outputArray(i, j) & """" & ","
            End If
            
            ' 最終列が来て最終行でなければ、最後の「,」を削除して、改行追加
            If j = endCol And i <> endRow Then
                outputText = Left(outputText, Len(outputText) - 1) & vbCrLf
            ' 最終列が来て最終行ならば、最後の「,」を削除
            ElseIf j = endCol And i = endRow Then
                outputText = Left(outputText, Len(outputText) - 1)
            End If
        Next j
    Next i
    
    'csvファイルを書き込み
    '出力先とファイル名をセット
    csvFilePath = FileName
    
'    Open csvFilePath For Output As #1
'    Print #1, outputText
'    Close #1
    
    ' 「UTF-8」と「Shift_JIS」を切り替えられるように改造。20240201
    
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 2 ' テキストモード
    
    If code = "" Then
        stream.Charset = "shift_jis"
    Else
        stream.Charset = "utf-8"
    End If
    
    stream.WriteText outputText
    stream.SaveToFile csvFilePath, 2 ' オーバーライトモード
    stream.Close
    
End Sub

Dim arr() As Variant

Private Sub test､シートを配列に入れ､csvファイルに出力()
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample5.csv", True)
End Sub

Dim arr() As Variant

Private Sub test､シートを配列に入れ､csvファイルに出力1()
    ' (ws, ByRef arr, Optional RejectRw = 0)
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    ' (ByRef arr, FileName, Optional 種類)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample6.csv", "サンプル")
End Sub

Dim arr() As Variant

Private Sub test､シートを配列に入れ､csvファイルに出力2()
    Call sheet_to_array(ThisWorkbook.Worksheets("TEST"), arr)
    Call array_to_csv(arr, ThisWorkbook.Path & "\sample7.csv", , "utf-8")
End Sub