RecordSetからcsv、tsvファイルを出力する

Accessのテーブルからtsvファイルを出力しようとしたところ、意外と簡単に出す方法がありませんでした。

備忘録のために残しておこうと思います。

※カンマ区切りのcsv出力はTransferTextでできるのですが、不便なので。

RecordSetからcsv、tsvファイルを出力のコード
RecordSetからcsv、tsvの出力結果
- テーブルの中身
- 出力結果

RecordSetからcsv、tsvファイルを出力のコード

やる処理はざっくり説明すると以下です。

①ヘッダーをRecordSetから区切り文字付きで取り出す
②データをRecordSetから区切り文字付きで取り出す
③ファイルにヘッダーとデータを出力

'==============================================
'目的       ：Accessファイルが配置されている場所にCsv or Tsvファイル出力する
'引数       ：Delimiter      区切り文字：vbTab(タブ)　,(カンマ)
'              ：Rs                出力するレコードセット
'戻り値      :
'==============================================
Private Sub ExportRecordSet(Delimiter As String, Rs As DAO.Recordset)
Dim strPath As String                           '出力先のパス
Dim strTblName As String                    'テーブル名
Dim Header As String                           'テーブルのヘッダー行
Dim DataRecords As String                   'テーブルのデータ行
Dim Extension As String                        'ファイル拡張子
Dim RsCol As Long                                'カラムカウント用
Dim loopcount As Long
'出力パスを指定
strPath = CurrentProject.Path & "\"      "
strTblName = "テーブル"
'拡張子をセット
If Delimiter = "," Then
Extension = ".csv"
ElseIf Delimiter = vbTab Then
Extension = ".tsv"
End If
'---------------ヘッダー行を格納する処理---------------
'列数分ループ
For RsCol = 0 To Rs.Fields.Count - 1
Header = Header & Rs.Fields(RsCol).Name & Delimiter
Next RsCol
'行の最後に着いたカンマorタブを削除
Header = Left(Header, Len(Header) - 1)
'Rs.RecordCount取得用処理
Rs.MoveLast
Rs.MoveFirst
'---------------データ行を格納する処理---------------
' 先頭レコードからEOFまで繰り返す
Do Until Rs.EOF
loopcount = loopcount + 1
'列数分ループ
For RsCol = 0 To Rs.Fields.Count - 1
DataRecords = DataRecords & Rs.Fields(RsCol).Value & Delimiter
Next RsCol
'行の最後に着いたカンマorタブを削除
DataRecords = Left(DataRecords, Len(DataRecords) - 1)
'最終行の時は改行しない、それ以外は改行する
If Rs.RecordCount <> loopcount Then
'データ行を改行
DataRecords = DataRecords & Chr(13) & Chr(10)
End If
'次のレコードへ
Rs.MoveNext
Loop
'---------------ファイルに出力---------------
Open strPath & strTblName & Extension For Output As #1
Print #1, Header & Chr(13) & Chr(10) & DataRecords
Close #1
MsgBox "出力完了しました。"
End Sub

'==============================================

'目的：Accessファイルが配置されている場所にCsv or Tsvファイル出力する

'引数：Delimiter 区切り文字：vbTab(タブ)　,(カンマ)

' ：Rs 出力するレコードセット

'戻り値 :

'==============================================

Private Sub ExportRecordSet(Delimiter As String, Rs As DAO.Recordset)

Dim strPath As String '出力先のパス

Dim strTblName As String 'テーブル名

Dim Header As String 'テーブルのヘッダー行

Dim DataRecords As String 'テーブルのデータ行

Dim Extension As String 'ファイル拡張子

Dim RsCol As Long 'カラムカウント用

Dim loopcount As Long

'出力パスを指定

strPath = CurrentProject.Path & "\" "

strTblName = "テーブル"

'拡張子をセット

If Delimiter = "," Then

Extension = ".csv"

ElseIf Delimiter = vbTab Then

Extension = ".tsv"

End If

'---------------ヘッダー行を格納する処理---------------

'列数分ループ

For RsCol = 0 To Rs.Fields.Count - 1

Header = Header & Rs.Fields(RsCol).Name & Delimiter

Next RsCol

'行の最後に着いたカンマorタブを削除

Header = Left(Header, Len(Header) - 1)

'Rs.RecordCount取得用処理

Rs.MoveLast

Rs.MoveFirst

'---------------データ行を格納する処理---------------

' 先頭レコードからEOFまで繰り返す

Do Until Rs.EOF

loopcount = loopcount + 1

'列数分ループ

For RsCol = 0 To Rs.Fields.Count - 1

DataRecords = DataRecords & Rs.Fields(RsCol).Value & Delimiter

Next RsCol

'行の最後に着いたカンマorタブを削除

DataRecords = Left(DataRecords, Len(DataRecords) - 1)

'最終行の時は改行しない、それ以外は改行する

If Rs.RecordCount <> loopcount Then

'データ行を改行

DataRecords = DataRecords & Chr(13) & Chr(10)

End If

'次のレコードへ

Rs.MoveNext

Loop

'---------------ファイルに出力---------------

Open strPath & strTblName & Extension For Output As #1

Print #1, Header & Chr(13) & Chr(10) & DataRecords

Close #1

MsgBox "出力完了しました。"

End Sub

因みにRecordSetはAccessでもエクセルでも使うことはできます。

ただ、SQLの知識が少し必要なので、参考書やwebサイトで勉強した方が良いと思います。

VBA C# オススメ参考書プログラミングの参考書でオススメの紹介をしていきます。それぞれ私が使っている言語のみです。 VBAのオススメ参考書をExc...

2020/06/13 追記

ダブルクォーテーションで区切るバージョンと区切らないバージョンの2つに変更しました。

購入者の方から、ダブルクォーテーションで区切って欲しいと声があったためです。

ダウンロード時には2種類のアクセスがダウンロードされます。

RecordSetからcsv、tsvの出力結果

実際に作った処理を動かしてみます。

テーブルの中身

出力元のテーブルは以下のようになっています。

supplier_cd	addr	post_num	tel	fax
301101	明治屋	埼玉県川越市	NULL	03-**-**
301102	パスコ	東京都江戸川区	NULL	4-**-**
301103	ライヘルフ	大阪府東大阪市	NULL	5-**-**
301104	リプトン紅茶	東京都港区	NULL	6-**-**
301105	上島珈琲	横浜市中区	NULL	7-**-**
301106	流通パートナーズ	NULL	NULL	8-**-**
301107	全食	千葉市美浜区	NULL	9-**-**
301108	大地	新潟県新潟市	NULL	10-**-**
301109	明治乳業	東京都江東区	NULL	11-**-**
301200	キッコーマン	千葉県野田市	NULL	NULL
301201	片岡物産	川崎市川崎区	NULL	NULL
301202	ロイヤル食品	福岡市那珂区	NULL	NULL
301203	東京製菓	東京都大田区	NULL	NULL
301204	武州フーズ	埼玉県入間郡	NULL	NULL
301205	コカコーラボトリング	NULL	NULL	NULL