【VBA】PostgreSQLにインポートできるようにCSVファイルを作成したい

Question

前提

VBAでCSVファイルを出力するマクロを作っています。
CSVファイルはPostgreSQLの社員マスタにインポートできるように形式を調整して作成します。下記URLを参考にしています。
・【超簡単】ワンタッチでエクセルからCSV出力するVBAプログラム
・PostgreSQLでCSVファイルをインポート／エクスポートする方法

該当のソースコード

全てのセル値を「""」で囲んで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

インポートするテーブルのソースです。文字数制限のため一部のみ記載していますが、文字コードは"メールアドレス"のtextを除き、全てcharacterです。

CREATE TABLE public."t_社員マスタ" (
    "社員番号" character(8) NOT NULL,
    "氏名" character(16),
    "氏名カナ" character(24),
    "生年月日" character(8),
　　・
　　・
　　・
    "メールアドレス" text
);
ALTER TABLE ONLY public."t_社員マスタ"
    ADD CONSTRAINT "t_社員マスタ_pkey" PRIMARY KEY ("社員番号");

発生している問題

上記のコードでCSVファイルは問題なく出力されますが、コードを社内でレビューを行った際、Openメソッドを使って出力する方法はできませんか、という修正依頼を受けました。

実現したいこと

・「csv.Output」を「Openメソッド」でCSV出力するように書き換える
・CSVファイルの文字コードは全てShift-JISにする

試したこと

VBAコードで「utf-8」を「Shift-JIS」に全て置き換えて実行したところエラーは起きませんが、t_社員マスタに正しく格納できるか確認する方法がよく分からない状況です。
また、「Openメソッド」「Openステートメント」などで検索して調べましたが、ACCESSのテーブルを読み込み、Excelに書き込むようなイメージだったのですが、Excelのみで「Open」を使うメソッドは存在するのでしょうか。
「csv.Output」の修正案をご教示いただければ幸いです。
よろしくお願いいたします。

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

PC：Windows11
ソフト：Microsoft365 Excel

Comments

[sazi]

「Openメソッドを使って出力する方法はできませんか？」

現状は、「ADODB.stream」を使用しているので、それを変更するという要望なのでしょうか？
ですが、そもそもどのような理由による変更要望なのでしょうか？

[hatena19]

検索するときに Excel とか シート などを検索ワードに追加すればいくらでも見つかります。
例えば下記など
https://tonari-it.com/vba-txt-print/
https://youseful.jp/microsoft/excel/vba-csv/

ただ、CSV出力するだけなら、SaveAsを使うなどもっと簡単な方法もあるのに、なぜOpenメソッドにこだわるのかは意味不明です。

[koburon]

>sazi様
>hatena19様

コメントありがとうございます。
「Openステートメント」に変更する理由について、レビュー担当者に確認したところ、
「t_社員マスタ」テーブルに入る項目は全て文字コードがShift-JISのみなので、CSVファイルを読み込む方法として「Openステートメント」を使用した関数を使った方が汎用性があり、今後、別のマクロを作成するときに参考になって役立つから、とのことでした。

「Openステートメント」と「ADODB.Stream」の違いについて調べて下記URLを見つけたので確認したところ、

https://nyanblog2222.com/office/2291/#toc5

「ADODB.Stream」を使用する方法はUTF-8、Shift-JISを含む各種文字コードに対応しているようですが、この認識で間違いないでしょうか。

[nonoshu]

「ADODB.Stream」を使用する方法はUTF-8、Shift-JISを含む各種文字コードに対応していますね。
私個人はADODB.Streamの方が汎用性があると感じてますが、
環境や社内文化が異なるので、それに従う方がいいのではないでしょうか。

[koburon]

>odataiki様
コメントありがとうございます。
企業よって「こうした方がいい」という独自の文化やルールがあるということですね。
社内でよく打合せして相談してからそれに従って作成しようと思います。

Answer 1

open関数を使用した例です。
下記を参考しています。
参考URL
出力開始列＝１　出力終了位置＝７　にしています。変える場合は
Const stCol = 1
Const enCol = 7
の値を変えてください。
出力するファイル名は
csvFile = "d:\goo\data8\sample.csv"
と固定にしています。あなたの環境に合わせて適切に設定してください。
両端をダブルクオートでくくって出力します。

Public Sub CSV出力()
    Dim ws As Worksheet
    Dim maxrow As Long
    Dim csvFile As String
    Dim fileNo As Integer
    Dim wrow As Long
    Dim wcol As Long
    Dim i As Long
    Dim val As String
    Dim out_line As String
    Const stCol = 1
    Const enCol = 7
    Dim arrVal(enCol - stCol) As String
    
    csvFile = "d:\goo\data8\sample.csv"
    Set ws = ActiveSheet
    maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    fileNo = FreeFile
    Open csvFile For Output As #fileNo
    For wrow = 3 To maxrow
        i = 0
        For wcol = stCol To enCol
            '1データ取得
            val = ws.Cells(wrow, wcol).Value
            'データをダブルクオートでくくり、配列へ格納
            arrVal(i) = wrap_data(val)
            i = i + 1
        Next
        'カンマで連結
        out_line = Join(arrVal, ",")
        Print #fileNo, out_line
    Next
    Close #fileNo
    MsgBox ("CSVファイルを「Shft_JIS」で出力しました。レコード部分のみ出力しています。")
End Sub

'入力文字列をダブルクオートでくくる
Private Function wrap_data(ByVal val As String) As String
    wrap_data = """" & val & """"
End Function

```　

Comments

[koburon]

回答ありがとうございます。
いただいたコードを元に、ファイルの出力先と表の列数を変更して試したところ、問題なく動作し、目的通りのCSVファイルを作成できました。
ベストアンサーとさせていただきます。
ありがとうございました。