「こんなのあったらいいな」の声をお届けください！

実際に作ったファイルはこちらからダウンロードできます。

出力結果も載せているので、解説と合わせて見ていただければと思います。

エクセル参照設定

まずAccessファイルにエクセルを取り込むときに、エクセルを操作しなければなりません。

そのため、エクセル操作ができるよう参照設定を行います。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Excel 16.0 Object Libraryを追加してください。

16.0はバージョンに寄ります。

エクセルの色付け 罫線引きサンプルコード

ボタンクリック後のメイン処理を記載します。

処理の流れは以下です。

'==============================================
'処理　　　 ：Excel出力ボタン押下時
'==============================================
Private Sub ExportExcel_Click()

　　Dim db As DAO.Database　　　　　　　　　　　　　　　　'DBの変数
　　Dim RS_Supplier As DAO.Recordset　　　　　　　　　　'レコードセット
　　Dim MyDir As String　　　　　　　　　　　　　　　　　　'ツールが存在しているディレクトリ
　　
　　'DBをセット
　　Set db = CurrentDb
　　
　　'自分の配置されているパスを取得
　　MyDir = Application.CurrentProject.Path
　　
　　'レコードセットへテーブルのデータを取得
　　Set RS_Supplier = db.OpenRecordset(GetSupplier())
　　
　　'空エクセルファイルを開く
　　Workbooks.Open (MyDir & "\nothing.xlsx")

　　'アラート表示をオフにする
　　ActiveWorkbook.Application.DisplayAlerts = False

　 '列名をエクセルに出力
　　Call SetRsColValue(ActiveSheet, RS_Supplier, 1, 1)
　　
　 'レコードセットをエクセルに出力
　　Call SetRsValue(ActiveSheet, RS_Supplier, 2, 1)
　　
　　'ヘッダーの色を付ける
　　ActiveSheet.Range(Cells(1, 1), Cells(1, RS_Supplier.Fields.Count)).Interior.Color = RGB(204, 204, 204)
　　
　　'2～3列目の色を付ける
　　ActiveSheet.Range(Cells(2, 2), Cells(RS_Supplier.RecordCount + 1, 3)).Interior.Color = RGB(221, 235, 247)
　　
　　'罫線を引く
　　ActiveSheet.Range(Cells(1, 1), Cells(RS_Supplier.RecordCount + 1, RS_Supplier.Fields.Count)).Borders.LineStyle = xlContinuous
　　
　　'列幅を調節
　　ActiveSheet.Range(Cells(1, 1), Cells(RS_Supplier.RecordCount + 1, RS_Supplier.Fields.Count)).EntireColumn.AutoFit
　　
　 'エクセル保存
　　ActiveWorkbook.SaveAs FileName:=MyDir & "\RS_Supplier.xlsx"

　　'エクセルを閉じる
　　ActiveWorkbook.Close
　　
　　'レコードセットを開放
　　Set RS_Supplier = Nothing
　　
　　MsgBox "出力完了しました。"

End Sub

解説

列名とテーブルデータをエクセルに出力する箇所は次で説明します。

ヘッダーの色を付ける

色付けする範囲をRangeで指定しています。

A1セル～A6セルまでに色を付けています。

範囲の開始位置はCells(1, 1)です。

範囲の終了位置はレコードセットの列数で指定しています。

なので、このロジックであれば列数が増えても汎用的に色付けできます。

2～3列目の色を付ける

こちらもRange指定でB2～C16までを色付けしています。

範囲の開始位置はCells(2, 2)でB2を指定しています。

範囲の終了位置はCells(RS_Supplier.RecordCount + 1, 3)でC16を指定しています。

RS_Supplier.RecordCount + 1で範囲の最終行と同じ数字になります。

レコードセットのデータは列含まないため+1しないといけません。

そのためテーブルデータの行数＋１をしています。

これもテーブルの行数が増えても汎用的に使えます。

罫線を引く

こちらもRange指定でA1～F16までを色付けしています。

Cells(1, 1), Cells(RS_Supplier.RecordCount + 1, RS_Supplier.Fields.Count)

RS_Supplier.RecordCount + 1で行数

RS_Supplier.Fields.Countで列数になるため、データがある範囲を対象にすることができます。

https://loosecarrot.com/2018/12/09/1800/#01-2

テーブルのエクセル出力

列名のエクセル出力

'==============================================
'目的　　　 ：エクセルのセルへ列名をセットする
'引数　　　 ：Worksheet　　　 対象シート
'　　　　　 ：rs　　　　　　　 レコードセット
'　　　　　 ：StartRow　　　　出力する行
'　　　　　 ：StartCol　　　　出力開始のカラム
'戻り値　　 : 選択したファイルパス
'==============================================
Public Sub SetRsColValue(WS As WorkSheet, ByVal rs As DAO.Recordset, StartRow As Long, StartCol As Long)
　　Dim ExcelCol As Long
　　Dim RsCol As Long
　　　　
　　With WS

　　　　' 全列をシートに展開
　　　　For RsCol = 0 To rs.Fields.Count - 1
　　　　　　.Cells(StartRow, StartCol).Value = rs.Fields(RsCol).Name
　　　　　　StartCol = StartCol + 1
　　　　Next RsCol
　　
　　End With
　　
　　Set rs = Nothing
　　
End Sub

解説

エクセルの出力開始の行番号と列番号をStartRowとStartCol で引数で受取ります。

その後、列数分ループしながら列名を順番に出力する処理になっています。

RecordSetデータのエクセル出力

'==============================================
'目的　　　 ：エクセルのセルへ値をセットする
'引数　　　 ：Worksheet　　　 対象シート
'　　　　　 ：rs　　　　　　　 レコードセット
'　　　　　 ：StartRow　　　　出力する行
'　　　　　 ：StartCol　　　　出力開始のカラム
'戻り値　　 : 選択したファイルパス
'==============================================
Public Sub SetRsValue(WS As WorkSheet, ByVal rs As DAO.Recordset, StartRow As Long, StartCol As Long)
　　Dim Row As Long
　　Dim ExcelCol As Long
　　Dim RsCol As Long
　　
　　rs.MoveFirst
　　
　　With WS
　　
　　　　'出力開始行をセット
　　　　Row = StartRow
　　　　
　　　　' 先頭レコードからEOFまで繰り返す
　　　　Do Until rs.EOF
　　　　
　　　　　　'列を先頭に戻す
　　　　　　ExcelCol = StartCol
　　　　　　
　　　　　　' 全列をシートに展開
　　　　　　For RsCol = 0 To rs.Fields.Count - 1
　　　　　　　　.Cells(Row, ExcelCol).Value = rs.Fields(RsCol).Value
　　　　　　　　ExcelCol = ExcelCol + 1
　　　　　　Next RsCol
　　　　　　
　　　　　　'行を加算
　　　　　　Row = Row + 1
　　　　　　
　　　　　　'次のレコードへ
　　　　　　rs.MoveNext
　　　　Loop
　　End With
　　
　　Set rs = Nothing
　　
End Sub

解説

列出力と同様に、エクセルの出力開始の行番号と列番号をStartRowとStartCol で引数で受取ります。

出力開始位置から1セルずつ、右に移動しながら出力していきます。

1ループ(1行分)終了すると次の行へ出力していきます。

出力結果

出力結果はこんな風になります。

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/

実際に作ったファイルはこちらからダウンロードできます。

ダイアログ用の参照設定

ファイル用もフォルダ用もダイアログを開くに参照設定を必要です。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Office 16.0 Object Libraryにチェックを付けておいてください。

16.0はバージョンに寄ります。

ファイルパス取得のダイアログ コード

ファイルパス取得用のダイアログは以下のような書き方です。

処理の流れは以下の順です。

'=======================================
'目的　　　 ：選択したファイルのフルパスを取得
'=======================================
Private Sub GetFilePath_Click()

　　'変数定義
　　Dim intRet As Integer　　　　 'ダイアログ用変数
　　Dim FilePath As String　　　　 'フルパス用変数

　　With Application.FileDialog(msoFileDialogOpen)
　　　　.Title = "取込みファイル設定ダイアログ"
　　　　.Filters.Clear
　　　　.Filters.Add "Microsoft Office Excelファイル", "*.xls,*.xlsx,*.xlsm"
　　　　.FilterIndex = 1
　　　　
　　　　'複数ファイル選択を許可しない
　　　　.AllowMultiSelect = False
　　　　
　　　　'初期パスを設定
　　　　.InitialFileName = CurrentProject.Path
　　　　
　　　　'ダイアログを表示
　　　　intRet = .Show

　　　　'ファイルが選択された場合
　　　　If intRet <> 0 Then
　　　　　'パスを設定
　　　　　FilePath = Trim(.SelectedItems.Item(1))

　　　　　'パスを表示
　　　　　MsgBox FilePath
　　　　　
　　　　Else
　　　　　'ファイルが選択されていない場合
　　　　　MsgBox "キャンセルしました。"
　　　　　
　　　　End If
　　　　
　　End With
　　　　
End Sub

https://loosecarrot.com/2018/12/09/1800/

解説

FileDialogのShowでダイアログを出します。

ダイアログで選択したファイルがある場合intRetには結果引数として「-1」が返ってきます。

ファイルを選択しなかった場合、「0」が結果引数として返ってきます。

ファイルを選択した場合、SelectedItems.Item(1)にファイルのパスが取得されます。

例えば、ダイアログから取得したファイルパスを使ってエクセルをAccessに取込むというような処理に使えそうですね。

https://loosecarrot.com/2018/11/26/1510/

補足

・フィルタ設定

エクセル関係のファイルだけしか表示されないようにしています。

用途によっては「*」でも良いでしょう。

・複数ファイル選択許可

1ファイルだけに設定していますが、複数も可能です。

その場合、FilePath = Trim(.SelectedItems.Item(1))の番号は選択したファイル番号を設定する必要があります。

フォルダのパス取得のダイアログ コード

フォルダパス取得用のダイアログは以下のような書き方です。

処理の流れは以下の順です。

'=======================================
'目的　　　 ：選択したフォルダのパスを取得
'=======================================
Private Sub GetFolderPath_Click()

　　Dim FolderPath As String　　　'フォルダパス用変数
　　
　　'ファイルダイアログを開く
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　If .Show = True Then
　　　　　　'パスを設定
　　　　　　FolderPath = .SelectedItems(1)
　　　　　　
　　　　　　'パスを表示
　　　　　　MsgBox FolderPath
　　　　End If
　　　　
　　　　'フォルダが選択されていない場合
　　　　If FolderPath = "" Then
　　　　
　　　　　　MsgBox "キャンセルしました。"
　　　　　　
　　　　End If
　　　　
　　End With
　　
End Sub

解説

FileDialogのShowでダイアログを出します。(ファイルパス取得と同じ)

ダイアログで選択した場合、Trueが返ってきます。

Trueの場合、SelectedItems(1)に選択したフォルダのパスがセットされています。

なので、FolderPathの変数に選択したパスをセットしています。

ロジックとしてFolderPathに何も入っていない場合、フォルダ選択をやめる以外はありません。

そのため、FolderPathが空白ならキャンセルされましたと表示をしています。

例えば、ダイアログを表示して指定したフォルダにAccessからtsvやcsvを出力するときなどに使えそうですね。

https://loosecarrot.com/2018/11/20/1459/

補足

・複数フォルダ選択

複数フォルダ選択はできないようです。

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/

作ってみたので残しておきます。

実際に作ったファイルはこちらからダウンロードできます。

エクセル取込み – エクセル参照設定

まずAccessファイルにエクセルを取り込むときに、エクセルを操作しなければなりません。

そのため、エクセル操作ができるよう参照設定を行います。

手順はコードエディターから「ツール(T)」→「参照設定(R)」と移動します。

その後、Microsoft Excel 16.0 Object Libraryを追加してください。

16.0はバージョンに寄ります。

エクセル取込みのコード

処理の流れは以下の順です。

※1テーブルをAccessに作っておく必要があります。
※2テーブル名とシート名は同じ必要があります。

https://loosecarrot.com/2018/11/28/1511/

'=======================================
'目的　　　 ：エクセルデータをインポートする
'=======================================
Private Sub ImportExcel_Click()

　　Dim MyDir As String
　　Dim InputFilePath As String
　　Dim i As Long
　　Dim mySheetCnt As Long
　　Dim SheetNames() As String
　　Dim wb As Workbook
　　
　　'自分の配置されているパスを取得
　　MyDir = Application.CurrentProject.Path
　　
　　'①----------ファイルダイアログを開いて取込むエクセルのパスを取得する----------
　　'取込みファイルパスを取得
　　InputFilePath = GetFilePath()
　　
　　'アラート表示をオフにする
　　DoCmd.SetWarnings False
　　
　　'取得パスが空白でなければ処理開始
　　If InputFilePath <> "" Then
　　
　　　　'②----------エクセルのシート名を取得----------
　　　　'エクセルを開く
　　　　Workbooks.Open (InputFilePath)
　　　　Set wb = ActiveWorkbook
　　　　
　　　　'配列の数を再定義
　　　　ReDim SheetNames(ActiveWorkbook.Sheets.Count)
　　　　
　　　　'シートを配列に取得
　　　　For i = 1 To ActiveWorkbook.Sheets.Count
　　　　　　SheetNames(i) = ActiveWorkbook.Sheets(i).Name
　　　　Next i
　　　　
　　　　'エクセルを閉じる
　　　　wb.Close False
　　　　
　　　　'③----------エクセルのシートを全て取り込む----------
　　　　'シート分取込みを実行
　　　　For i = 1 To UBound(SheetNames)
　　　　
　　　　　　'シート名がテーブル名に存在する場合、取込む　存在しない場合、スキップ
　　　　　　If DCount("*", "MSysObjects", "[Name]='" & SheetNames(i) & "'") > 0 Then
　　　　　　　　'対象テーブルを削除
　　　　　　　　DoCmd.RunSQL "DELETE * FROM " & SheetNames(i)
　　　　　　　　
　　　　　　　　'各マスタテーブルへエクセルデータを取込む
　　　　　　　　DoCmd.TransferSpreadsheet _
　　　　　　　　　　acImport, _
　　　　　　　　　　acSpreadsheetTypeExcel12Xml, _
　　　　　　　　　　SheetNames(i), _
　　　　　　　　　　InputFilePath, _
　　　　　　　　　　True, _
　　　　　　　　　　SheetNames(i) & "!"
　　　　　　 End If
　　　　Next i

　　　　MsgBox "取込みが完了しました。"
　　Else
　　　　MsgBox "取込をキャンセルしました。"
　　End If
　　
End Sub

補足

４９行目のテーブルデータ削除についてです。

以下の処理で一度テーブルデータを一括削除してからテーブルに取込んでいます。

削除しないとどんどん行数が増え続けていくためです。

DoCmd.RunSQL “DELETE * FROM ” & SheetNames(i)の中身

指定したテーブル名を引数に受け取っています。

そして指定したテーブルのレコードすべてを削除するようにしています。

https://loosecarrot.com/2018/12/09/1800/

エクセル取込み時に255文字で切れる

一つ問題がありました。

この処理だけでは文字数が255を超える場合、文字が切れてしまう可能性があります。

たとえ、文字型を「長いテキスト」にしたとしてもです。

長いテキストにすれば1GB分まで格納できるはずなのですが、なぜ?と思っていました。

原因は最初の8行が255文字以上でないと、自動でMAX文字数を255とAccess側で判断してしまうためだそうです。

この対応は他で行って公開できればと思います。

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/

他のサイトでも3テーブルの結合までは書いていたのですが、4つ以上の書き方がありませんでした。

備忘録として残しておきます。

実際に作ったファイルはこちらからダウンロードできます。

SQLの知識が必要なので、ゼロからはじめるデータベース操作がおすすめです。

Access SQLで2テーブルの結合

2つのテーブルを結合する場合の書き方です。

GoodsテーブルとRecipeテーブルを結合する場合を例にします。

抽出元

■Goodsテーブル

■Recipeテーブル

SQL

SELECT
 Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Recipe.necessary_num
FROM Goods

LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd)

WHERE Goods.Goods_cd = 101004

ポイントとしては、

LEFT JOIN Recipe ON (Goods.Goods_cd = Recipe.goods_cd)

のようにON以降を()で囲む必要があることです。

https://loosecarrot.com/2018/12/09/1800/

Access SQLで3テーブルの結合

3つのテーブルを結合する場合の書き方です。

先ほどのGoodsテーブルとRecipeテーブルに加えて、

Foodsテーブルを結合する場合を例にします。

抽出元

■Foodsテーブル

SQL

SELECT
Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Foods.ｆoods_name
,Foods.supplier_cd

FROM (Goods

LEFT JOIN Recipe 
ON (Goods.Goods_cd = Recipe.goods_cd))

LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd)

WHERE Goods.Goods_cd = 101004

ポイントはFROM直後～一つ目のJOINが終わるところまでを()で囲むところです。

FROM (Goods
LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd))

https://loosecarrot.com/2018/11/20/1459/

Access SQLで4テーブルの結合

3つのテーブルを結合する場合の書き方です。

先ほどのGoodsテーブル、Recipeテーブル、Foodsテーブルに加えて、

Supplierテーブルを結合する場合を例にします。

抽出元

■Supplierテーブル

SQL

SELECT
Goods.Goods_cd
,Goods.Goods_name
,Goods.price
,Recipe.food_cd
,Foods.ｆoods_name
,Foods.supplier_cd
,Supplier.supplier_cd
,Supplier.supplier_name

FROM ((Goods

LEFT JOIN Recipe 
ON (Goods.Goods_cd = Recipe.goods_cd))

LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd))

LEFT JOIN Supplier
ON (Foods.supplier_cd = Supplier.supplier_cd)

WHERE Goods.Goods_cd = 101004

ポイントはFROM直後～二つ目のJOINが終わるところまでを()で囲むところです。

FROM ((Goods
LEFT JOIN Recipe
ON (Goods.Goods_cd = Recipe.goods_cd))
LEFT JOIN Foods
ON (Recipe.food_cd = Foods.foods_cd))

結合テーブルが増えた時の書き方パターン

結合するテーブル数が5、6、7…と増えても()で囲む数が増えていくだけです。

2,3,4テーブルはすべてテーブル単位の()に色付けして分かりやすくしています。

これを覚えておけば問題ありません。

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/

DataTableではなく、RecordSetを使うことで同じような感じで処理ができます。

使い方の備忘録として残しておきます。

テーブルをRecordSetに取得するコード

処理としては以下の抜粋から紹介します。

https://loosecarrot.com/2018/11/20/1459/

作成したAccessファイルはこちらからダウンロードできます。

テーブルをRecordSetに取得する書き方

以下のような書き方です。

※RecordSetにSELECT結果を格納しているのは13行目です。

'=============================================='
'処理　　　 ：csv出力ボタン押下時'
'=============================================='
Private Sub ExportCsv_Click()
　　
　　Dim db As DAO.Database　　　　　　　　　　　　　　　　　　'DBの変数
　　Dim RS_Supplier As DAO.Recordset　　　　　　　　　　　　'レコードセット
　　
　　'DBをセット
　　Set db = CurrentDb
　　
　　'レコードセットへテーブルのデータを取得
　　Set RS_Supplier = db.OpenRecordset(GetSupplier())
　　
　　'レコードセットをファイル出力
　　Call ExportRecordSet(",", RS_Supplier)
　　
End Sub

GetSupplier()の中身

SELECT文をGetSupplier()で作成しています。

SQLの知識が必要なので、ゼロからはじめるデータベース操作がおすすめです。

'=============================================='
'目的:　　　　Supplierテーブルからすべてを取得'
'引数：'
'戻り値:　　　SQL文'
'=============================================='
Public Function GetSupplier() As String
　　Dim SB As StringBuilder

　　'インスタンス化'
　　Set SB = New StringBuilder

　　SB.Clear

　　SB.AppendLine ("SELECT")
　　SB.AppendLine (" * ")
　　SB.AppendLine ("FROM Supplier")

　　GetSupplier = SB.GetString()
　　
End Function

https://loosecarrot.com/2018/12/09/1800/

StringBuilderについては次で解説しています。

StringBuilderクラス

StringBuilderもC#やVB.netには既存であるクラスなのですが、VBAにはありません。

なので簡単に作ってあります。

一つ作っておくと1つのAccessアプリでは使いまわせるので便利です。

'===================================================================='
' StringBuilderクラス'
'--------------------------------------------------------------------'
' create: 2018/02/20'
' update: 2018/02/20'
'===================================================================='
Option Compare Database

'========================================================='
' メンバ宣言'
'========================================================='
' 成形文字列'
Private strString As String

' 改行コード'
Private RTN_CODE As String

'========================================================='
' コンストラクタ'
'========================================================='
Private Sub Class_Initialize()

　　' 初期化'
　　strString = ""
　　RTN_CODE = Chr(13) & Chr(10)

End Sub

'========================================================='
' 成形した文字列を空文字にする'
'========================================================='
Public Sub Clear()

　　strString = ""

End Sub

'========================================================='
' 成形した文字列を取得する'
'---------------------------------------------------------'
' return　　　　　　　　　　成形した文字列'
'========================================================='
Public Function GetString()

　　GetString = strString

End Function

'========================================================='
' 文字列を追加'
'---------------------------------------------------------'
' param strAdd　　　　　　　追加する文字列'
'========================================================='
Public Sub Append(ByVal strAdd)

　　strString = strString & strAdd

End Sub

'========================================================='
' 文字列を追加'
'---------------------------------------------------------'
' param strAdd　　　　　　　追加する文字列'
'========================================================='
Public Sub AppendLine(ByVal strAdd)

　　Append (strAdd & RTN_CODE)

End Sub

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/

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

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

実際に作ったファイルはこちらから無料でダウンロードできます。

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

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

'==============================================
'目的       ：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サイトで勉強した方が良いと思います。

https://loosecarrot.com/2018/12/09/1800/

2020/06/13 追記

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

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

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

RecordSetからcsv、tsvの出力結果

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

テーブルの中身

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

出力結果

キレイに出力することができました。

※RecordSetにテーブルのデータを取得する箇所は別のところで紹介します。

https://loosecarrot.com/2018/11/22/1481/

https://loosecarrot.com/2019/02/11/3167/

https://loosecarrot.com/2018/12/09/1775/

https://loosecarrot.com/2019/01/28/3054/