【VBA】CSVファイル出力マクロでShift-JISからUTF-8に書き直したい

Question

前提

VBAでPostgreSQLのテーブル「t_社員マスタ」にインポートするCSVファイルを出力するマクロを作っています。

該当のソースコード

Sub writeCSV()
    Dim ws As Worksheet
    Dim maxrow As Long
    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 = 144
    Dim arrVal(enCol - stCol) As String
    Set ws = Worksheets("Sheet1")
    maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    fileNo = FreeFile
    
    Application.ScreenUpdating = False
    
    ' ----------------------------
    ' ファイルの出力処理
    ' ----------------------------
    Dim myFileName, fileName, fileDateNm As String
    
    ' ファイル名を作成する
    fileDateNm = Replace(CStr(Date), "/", "")
    fileName = "社員マスタ更新データ_" & fileDateNm
    ' ダイアログ表示
    myFileName = Application.GetSaveAsFilename(InitialFileName:=fileName, FileFilter:="CSV ﾌｧｲﾙ (*.csv),*.csv")
    ' キャンセルなら終了
    If myFileName = "False" Then
        Exit Sub
    End If
    ' 保存
    Open myFileName 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」で出力しました。レコード部分のみ出力しています。")

    Application.ScreenUpdating = True
End Sub

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

発生している問題・エラーメッセージ

上記コードで「Shft_JIS」形式のCSVが出来ましたが、SQL上でCOPYコマンドを実行したところ、以下のエラーメッセージが出ました。

COPY t_社員マスタ FROM '/public/csv/社員マスタ更新データ_20230206.csv' CSV
ERROR:  符号化方式"UTF8"で無効なバイトシーケンスです: 0x8d
CONTEXT:  t_社員マスタ_マクロテストのCOPY。行番号 1

実現したいこと

UTF-8でないと受付ないという意味だと思うので、上記コードを書き換えて「utf-8」形式のCSVを出力させたいです。

試したこと

下記URLを参考にし、コードを作成し直そうと思っています。
サンプルプログラムでは、ADODB.Streamオブジェクトを

1. 生成
2. 文字コード設定
3. オープン
4. 1行ずつ文字列を流し込む
5. CSVに保存
6. クローズ

という流れで作成するイメージは理解できましたが、元のコードで既に「Open myFileName」とオープンを宣言してしまっています。
Openをどのように書き直せば、UFF-8に設定できるようになるでしょうか？
あるいは、他に参考になるURLなどがあれば教えていただければ幸いです。
よろしくお願いいたします。

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

PC：Windows11
ソフト：Microsoft365 Excel
PostgreSQLのバージョン：9.0.1
PSql Editのバージョン：5.2.3.9
参考URL:エクセルVBAで文字コードUTF-8のCSVファイルを書き出す方法

コメントを受けて追記

下記のようにsjisを設定してみましたが、encodingの近辺の構文エラーとだけ表示され、具体的にどこがエラーなのかよく分からないです。

COPY t_社員マスタ FROM '/public/csv/社員マスタ更新データ_20230206.csv' with encoding 'sjis' csv;
ERROR:  "encoding"またはその近辺で構文エラー
LINE 1: ...lic/csv/社員マスタ更新データ_20230206.csv' with encoding '...

以前にもこのサイトで同じような質問があったので確認しましたが、postgreSQLのサーバー上にCSVを保存してありますが、うまくいかないです。

Answer 1

UTF-8でないと受付ない

Postgresql の COPY コマンドですがオプションを指定すれば SJIS のファイルでインポートも行えるようです。

■ Postgresql 9.1のCOPYでファイルの文字コードを指定する
https://symfoware.blog.fc2.com/blog-entry-942.html

COPY t_社員マスタ FROM '/public/csv/社員マスタ更新データ_20230206.csv' WITH encoding 'SJIS' CSV

Openをどのように書き直せば、UFF-8に設定できるようになるでしょうか？

どうしても VBA で行いたいということであれば、こちらをどうぞ。

Option Explicit

' StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2

' LineSeparatorsEnum
Const adCR = 13
Const adCRLF = -1
Const adLF = 10

' StreamWriteEnum
Const adWriteChar = 0
Const adWriteLine = 1

' SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2

Sub writeCSV()
    Dim ws As Worksheet
    Dim maxrow As Long
    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 = 2 ' 144
    Dim arrVal(enCol - stCol) As String
    Set ws = Worksheets("Sheet1")
    maxrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    fileNo = FreeFile
    
    Application.ScreenUpdating = False
    
    ' ----------------------------
    ' ファイルの出力処理
    ' ----------------------------
    Dim myFileName, fileName, fileDateNm As String
    
    ' ファイル名を作成する
    fileDateNm = Replace(CStr(Date), "/", "")
    fileName = "社員マスタ更新データ_" & fileDateNm
    ' ダイアログ表示
    myFileName = Application.GetSaveAsFilename(InitialFileName:=fileName, FileFilter:="CSV ﾌｧｲﾙ (*.csv),*.csv")
    ' キャンセルなら終了
    If myFileName = "False" Then
        Exit Sub
    End If
    
    
    Dim stream
    Set stream = CreateObject("ADODB.Stream")

    stream.Charset = "UTF-8"
    stream.LineSeparator = adLF
    

    ' 保存
    'Open myFileName For Output As #fileNo
     stream.Open
     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
         stream.WriteText out_line, adWriteLine
     Next
     
    stream.Position = 0 'ストリームの位置を0にする
    stream.Type = adTypeBinary 'データの種類をバイナリデータに変更
    stream.Position = 3 'ストリームの位置を3にする

    Dim byteData() As Byte '一時格納用
    byteData = stream.Read 'ストリームの内容を一時格納用変数に保存
    stream.Close '一旦ストリームを閉じる（リセット）

    stream.Open 'ストリームを開く
    stream.Write byteData 'ストリームに一時格納したデータを流し込む
    
     
    'Close #fileNo
    stream.SaveToFile myFileName, adSaveCreateOverWrite
    stream.Close
    
    
    MsgBox ("CSVファイルを「UTF-8」で出力しました。レコード部分のみ出力しています。")

    Application.ScreenUpdating = True
End Sub

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

少しハマった箇所としては、参考 URL にあったやり方だと UTF-8 出力時に BOM が付いてしまうというのがハマリどころでした。
下記を参考に BOM を除去するようにしてあります。

■ エクセルVBAでBOM無しのUTF-8でCSVファイルなどを出力する方法
https://tonari-it.com/excel-vba-utf8n-bom/

Comments

[koburon]

>cx20様
回答ありがとうございます。
コメントいただいた通りCOPYコマンドを実行したところ、WITH encoding の近辺でエラーが発生しました。
現在、PostgreSQL用のSQLエディタとしてPSqlEditのバージョン5.2.3.9を使用していますが、古いため実装されていないのでしょうか。

[cx20]

> ERROR: "encoding"またはその近辺で構文エラー

なんとなく「encoding」の指定がダメと言われている感じですね・・
> PSqlEditのバージョン5.2.3.9
ツールそのものよりもDB接続に使用しているライブラリ（libpq.dll）のバージョンの問題の気もしますが、
ツールが2004年のようですので、もしかしたら「encoding」をサポートしていない、ということもあるのかもしれません。

PostgreSQL 環境が手元に無いので試せないですが、
psql コマンドではどうでしょうか？

以下、psql コマンドの使用例になります。

■ RDS for PostgreSQL で SJISのCSVファイルをインサートする
https://dev.classmethod.jp/articles/rds-for-postgresql-sjis-csv-insert/

[cx20]

それと「encoding」の指定は、DBサーバー側とクライアント側で変換がサポートされている必要があります。
サポートされた組み合わせか否かは下記のコマンドで確認できるようです。（PostgreSQLに詳しくないので参考情報まで。）
「sjis_to_utf8」が表示されるようであれば、変換はサポートされているのだと思います。

■ PostgreSQL の搭載機能 / 自動エンコーディング変換の使い方 / P8 / LIST5：pg_conversion表
https://pr.biprogy.com/solution/tec/atlasbase/s33drt000005ei89-att/dbm_1001_postresql.pdf

select * from pg_conversion where conname like '%sjis%' limit 10;

実行例）
https://onecompiler.com/postgresql/3yx8wxguy

Output:

oid | conname |
------+----------------+
4522 | sjis_to_utf8 |

[koburon]

>サポートされた組み合わせか否か
コマンドを実行したところ、以下の結果になりました。
utf8からsjisへの変換はサポートされているようです。

Output:

name| namespace | owner | default |
------+-------------+--------+--------+
euc_jp_to_sjis | 11 | 10 | t|
sjis_to_euc_jp | 11 | 10 | t|
sjis_to_mic | 11 | 10 | t|
mic_to_sjis | 11 | 10 | t|
sjis_to_utf8 | 11 | 10 | t|
utf8_to_sjis | 11 | 10 | t|

[cx20]

マニュアルを確認してみたところ、PostgreSQL 9.0 だと ENCODING オプションの記載が無いですね。。
もしかしたら ENCODING オプションは 9.1 以降でしか使用できないのかもしれません。
https://www.postgresql.jp/document/9.0/html/sql-copy.html
https://www.postgresql.jp/document/9.1/html/sql-copy.html

[koburon]

>ENCODING オプションは 9.1 以降でしか使用できないのかもしれません。
その可能性はありますね。
元のコードでShft_JISではき出した後、excelで「CSV UTF-8」で保存したものでCOPYすると成功したので、
今回はVBAの段階でUTF-8に出力するようにしようと思います。