【VBA】OpenステートメントでＣSVを出力したい

Question

前提

VBAでCSVファイルを出力するマクロを作っています。
下記のURLを参考にして作っています。

参考URL：【超簡単】ワンタッチでエクセルからCSV出力するVBAプログラム

該当のソースコード

上記URLのコードをベースにしています。
シートの1行目、2行目を除いて全部で144列を「""」で囲んでCSV出力するように修正しました。

Option Explicit

Const EXT As String = ".csv"

Sub CSV出力_詳細指定()
  Dim Filepath As String
  Filepath = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")
  
  If Filepath = "False" Then
    End
  End If
  
  Call csv.Output(TargetSheet:=ActiveSheet, Filepath:=Filepath, _
                  StartRow:=3, StartCol:=1, _
                  WithQuoteCols:=GetSequence(1, 144), _
                  Charset:="utf-8")
                 
  MsgBox "CSVファイルを「UTF-8」で出力しました。レコード部分のみ出力しています。"
End Sub

Public Function GetSequence(minNum As Long, maxNum As Long) As String
    Dim i As Long
    For i = minNum To maxNum
        GetSequence = GetSequence & "," & i
    Next
    GetSequence = Mid(GetSequence, 2)
End Function

「csv.Output」の中身であるモジュールは以下の通りです。

Option Explicit

'この標準モジュールは変更しない

Enum CSVCols
  Default = 0  '当初設定に従う
  force = 1    '強制的に処理を行う
  Ignore = 2   '処理を行わない
End Enum

'CSV出力メインロジック
'正常終了時TRUEを返す　※現状は、エラー処理を行っていないので常にTRUEが返る
'※charset に utf-8n と指定すると「BOMなしUTF-8」でCSVデータを作成する
Function Output(TargetSheet As Worksheet, ByVal Filepath As String, _
    Optional ByVal StartRow As Long = 1, Optional ByVal EndRow As Long = 0, _
    Optional ByVal StartCol As Long = 1, Optional ByVal EndCol As Long = 0, _
    Optional ByVal WithFormatCols As String = "", Optional ByVal WithoutFormatCols As String = "", _
    Optional ByVal WithQuoteCols As String = "", Optional ByVal WithoutQuoteCols As String = "", _
    Optional ByVal Delimitar As String = ",", Optional ByVal LineEndingCode As String = vbCr & vbLf, _
    Optional ByVal QuoteChar As String = """", Optional ByVal CharReplaceQuote As String = """""", _
    Optional ByVal Charset As String = "shift_jis") As Boolean
   
  '出力範囲（行）の指定
  If EndRow = 0 Then
    EndRow = getLastRow(TargetSheet)
  End If
  
  '出力範囲（列）の設定
  If EndCol = 0 Then
    EndCol = getLastColumn(TargetSheet)
  End If
       
  '各列出力時の書式付きかどうかの処理方法を配列に格納
  Dim FormatOptionOfColumns() As Long
  FormatOptionOfColumns = setOption(WithFormatCols, WithoutFormatCols, StartCol, EndCol)
  
  '各列出力時に”で囲むかどうかの処理方法を配列に格納
  Dim QuoteOptionOfColumns() As Long
  QuoteOptionOfColumns = setOption(WithQuoteCols, WithoutQuoteCols, StartCol, EndCol)
                   
  'CSV出力データ準備
  Dim csvData As String
  
  Dim rowData() As String
  ReDim rowData(0 To EndCol - StartCol) As String
  
  Dim R As Long
  Dim c As Long
  For R = StartRow To EndRow
    For c = StartCol To EndCol
      rowData(c - StartCol) = convertFormatTowriteCSVFile(TargetSheet.Cells(R, c), StartCol, _
                                            Delimitar, QuoteChar, CharReplaceQuote, _
                                            FormatOptionOfColumns, QuoteOptionOfColumns)
    Next
    
  '1行のデータをデリミタ(区切り文字)でつないで、改行を付加
    csvData = csvData & Join(rowData, Delimitar) & LineEndingCode
  Next
    
'csv出力
  Output = writeCSVFile(csvData, Filepath, Charset)
    
End Function

Private Function getLastRow(TargetSheet As Worksheet) As Long
  Dim Row As Long
  Dim Column As Long
  
'UsedRangeで取得した最下行の右→左、最下行の1段上の右→左と走査していく
  For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
    For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastRow = Row
End Function

Private Function getLastColumn(TargetSheet As Worksheet) As Long
  Dim Row As Long
  Dim Column As Long
  
'UsedRangeで取得した最右行の下→上、最右行の1列左の下→上と走査していく
  For Column = TargetSheet.UsedRange.Column + TargetSheet.UsedRange.Columns.Count - 1 To 1 Step -1
    For Row = TargetSheet.UsedRange.Row + TargetSheet.UsedRange.Rows.Count - 1 To 1 Step -1
      If TargetSheet.Cells(Row, Column).Value <> "" Then
        GoTo Finally
      End If
    Next
  Next

Finally:
  getLastColumn = Column
End Function

'CSV出力時のオプション
'（１．書式付で出力するか、２．「”」で囲むかについての設定）
'を使いやすい形（配列）に格納する
Private Function setOption(WithCols As String, WithoutCols As String, minCol As Long, maxCol As Long)
  WithCols = "," & WithCols & ","
  WithoutCols = "," & WithoutCols & ","
  
  Dim ret() As Long
  ReDim ret(0 To maxCol - minCol)

  Dim c As Long
  For c = LBound(ret) To UBound(ret)
    If InStr(WithCols, "," & c + 1 & ",") Then
      ret(c) = CSVCols.force
    ElseIf InStr(WithoutCols, "," & c + 1 & ",") Then
      ret(c) = CSVCols.Ignore
    Else
      ret(c) = CSVCols.Default
    End If
  Next
  
  setOption = ret
End Function

'各セルの値をCSV出力用に加工する
Private Function convertFormatTowriteCSVFile(R As Range, BaseCol As Long, _
         Delimitar As String, QuoteChar As String, CharReplaceQuote As String, _
         FormatOptionOfColumns() As Long, QuoteOptionOfColumns() As Long)
  Dim Val As Variant
  Val = R.Value
               
  '書式を適用
  If FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    FormatOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And addFormat(Val) Then
    Val = R.Text
  End If
    
  '「”」で囲む　※データ中に「”」があれば、指定の値に置き換える
  If QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.force Or _
    QuoteOptionOfColumns(R.Column - BaseCol) = CSVCols.Default And AddQuote(Val, Delimitar, QuoteChar) Then
    Val = QuoteChar & Replace(Val, QuoteChar, CharReplaceQuote) & QuoteChar
  End If

  convertFormatTowriteCSVFile = Val
End Function

'CSVCols.Defaultの場合に、書式を適用するかどうかの判定
Private Function addFormat(Val As Variant) As Boolean
    addFormat = False
End Function

'CSVCols.Defaultの場合に、「”」で囲むかの判定。
Private Function AddQuote(Val As Variant, Delimitar As String, QuoteChar As String) As Boolean
  If InStr(Val, Delimitar) Or InStr(Val, QuoteChar) Or _
     InStr(Val, vbLf) Or InStr(Val, vbCr) Then
    AddQuote = True
  Else
    AddQuote = False
  End If
End Function

'CSVデータ出力
'正常終了時TRUEを返す
Private Function writeCSVFile(csvData As String, Filepath As String, Charset As String) As Boolean
  Dim removeBom As Boolean
  
  If Charset = "utf-8n" Then
    Charset = "utf-8"
    removeBom = True
  Else
    removeBom = False
  End If
  
'本来は、下記で変数宣言したいが、参照設定しない場合のために、変数宣言をObjectにする
'  Dim ST As ADODB.Stream
  Dim ST As Object
  Set ST = CreateObject("ADODB.stream")
  
  With ST
    .Mode = 3  'adModeReadWrite
    .Type = 2  'adTypeText
    .Charset = Charset
  
    .Open
    .WriteText csvData, 0  'adWriteChar
  End With
  
  If removeBom Then
'以下、Bom抜き処理
'BOM部分を読み飛ばして、その先から読み込む
    ST.Position = 0
    ST.Type = 1  'adTypeBinary
    ST.Position = 3

'別のストリームにバイナリとしてコピー
'    Dim ST2 As ADODB.Stream
    Dim ST2 As Object
    Set ST2 = CreateObject("ADODB.stream")
    
    With ST2
      .Mode = 3  'adModeReadWrite
      .Type = 1  'adTypeBinary
      .Open
  
      .Write ST.Read
    
      .SaveToFile Filepath, 2  'adSaveCreateOverWrite
      .Close
    End With
  Else
    ST.SaveToFile Filepath, 2  'adSaveCreateOverWrite
  End If
  
  ST.Close
  writeCSVFile = True
End Function

発生している問題

上記のコードでCSVファイルは問題なく出力できましたが、マクロのレビューを行った際、

「Openステートメント」でレコードをループしてCSVを出力できませんか？」

という提案（注文？）を受けました。
元々URLのソースコードを丸ごとコピー＆ペーストして必要な部分を修正しただけな上、「csv.Output」モジュールの詳細が確認できていないため、ロジックがあまり理解できていない状態です。

試したこと

「Openステートメント」「CSV出力」で検索した際、以下のサイトにサンプルコードがあったので、これを現在のCSV出力コードと合わせました。

参考URL：【VBA CSV出力】Openステートメント・FileSystemObject・Streamオブジェクト

Option Explicit

Const EXT As String = ".csv"

Sub CSV出力_詳細指定()
  Dim Filepath As String, rs As Recordset
  Filepath = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")
  
  If Filepath = "False" Then
    End
  End If
        
   'Openステートメントを追記(Append)モードで実行します。
   '追記が不要ならFor Outputを指定します。
    Open Filepath For Append As #1
        
   'レコードセットの行数分ループしてテキストファイルに書き込みます。
    Do Until rs.EOF
        Print #1, rs(0).Value & "," & rs(1).Value & _
                "," & rs(2).Value & "," & rs(3).Value & "," & rs(4).Value
        rs.MoveNext
    Loop
        
    'テキストファイルを閉じます。
    Close #1
        
End Sub

エラーメッセージ

上記のコードを実行したところ、エラーが発生しました。

コンパイルエラー:
ユーザ定義型は定義されていません。

調べたところ、「recordset」はACCESSで作成したテーブルに対して使用するプロパティのようで、rsの型が定義されていない、という意味だと思います。

実現したいこと

Openステートメントで正しく処理し、かつ前提のコードのように値をすべて「""」で囲んで、書式を「UTF-8」に出力するようにしたいです。
理解できていない部分が多く、調べようとしても何から調べたらいいかもわからない状態なので、ご教示いただければ幸いです。
よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

PC：Windows11
ソフト：Microsoft365 Excel

Comments

[hatena19]

Openステートメントは非常に古くからあるもので、UTF-8出力には対応してません。
VBAでUTF-8出力するなら、ADODB.Streamを使うのがデフォです。

ちなみに、参考URLは Access VBA のサイトなのでrecordsetを使ってるようです。Excelのシートを出力するなら他のサイトを探した方が参考になるでしょう。

[tatsu99]

hatena19さんの指摘通りです。
Openステートメントを使用してUTF-8の文字コード出力はできません。
よって、マクロのレビューの方には、
「OpenステートメントはUTF-8出力には対応していないので、Openステートメントで実装することは不可能です」と回答してください。

[koburon]

＞hatena19様
＞tatsu99様
コメントありがとうございます。
UTF-8出力には対応していない、ということですね。承知しました。
そのように回答してみます。

Answer 1

OpenステートメントはUTF-8出力には対応していないということなので、
レビュー者に回答の上、さらに対応が必要な場合は改めて質問させていただきます。