【Access】VBAでQueryDefsを作成してテーブルの特定項目のみをCSV出力する

Accessの機能の１つとしてテーブルに蓄積したデータをCSVに出力することができます。
今回は、VBAでQueryDefsを作成してテーブルの特定項目のみをCSV出力する方法についてご紹介します。

＜今回やること＞
１．VBAでQueryDefsを作成しクエリーを作成
２．クエリーのデータをCSVに出力
３．１で作成したクエリーを削除

QueryDefsとは

VBAでQueryDefsを作成するとイメージとしてはクエリを作成することができます。
予めクエリを作成しておく・・という事も可能ですが
VBAで実行することにより、メンテナンスもVBAだけで良くなったり
より詳細な絞込みを行ったり出力する項目の制御を行ったりできます。

画面にボタンとテキストを追加

画面にボタンとテキストを配置します。

テキスト
　名前：txt受付日
　書式：日付 (S)
ボタン
　名前：cmdCSV出力
　表題：CSVファイル出力

cmdCSV出力ボタンのクリックイベント

Rem ----------------------------------------------------------------------------------
Rem         Ｃｌｉｃｋ／CSV出力
Rem ----------------------------------------------------------------------------------
Private Sub cmdCSV出力_Click()
Dim strSql As String
Dim sMsg As String
Dim strNowTime As String
Dim strFilePath As String
Dim strSaveDir As String
Dim db As Database
Dim qd As QueryDef

On Error GoTo Error

    sMsg = "CSV出力します。よろしいですか？"
    If MsgBox(sMsg, vbInformation + vbYesNo + vbDefaultButton2, C_MSG_TITLE) = vbNo Then
        Exit Sub
    End If
    
    Me.Requery
    
    '--------------------
    ' 出力処理
    '--------------------
   
    ' 出力ディレクトリ
    strSaveDir = MyPath & "\csv\"
    If Dir(strSaveDir, vbDirectory) = "" Then
        MkDir strSaveDir
    End If
    ' タイムスタンプ取得
    strNowTime = Format(Date, "yymmdd") & "" & Format(Time, "hhnnss")
    ' ファイル保存先
    strFilePath = strSaveDir & "受付_" & strNowTime & ".csv"
   
    strSql = "SELECT"
    strSql = strSql & " uke_id AS 受付ID"
    strSql = strSql & " ,uke_no AS 受付番号"
    strSql = strSql & " ,shuso_div AS 区分"
    strSql = strSql & " ,uke_tanto_name AS 受付者"
    strSql = strSql & " ,tanto_name AS 担当者"
    strSql = strSql & " ,uke_date AS 受付日"
    strSql = strSql & " ,uke_date2 AS 受付日2"
    strSql = strSql & " ,uke_div AS 受付区分"
    strSql = strSql & " ,uke_other_memo AS 受付区分その他"
    strSql = strSql & " FROM"
    strSql = strSql & "   t_uke "
    
    If Me.txt受付日.Value <> "" Then
        strSql = strSql & " WHERE uke_date >= #" & CDate(Me.txt受付日.Value) & "#"
    End If
    
    strSql = strSql & " ORDER BY uke_date"

    Set db = CurrentDb
    
    '--------------------
    ' QueryDefs作成
    '--------------------
    Set qd = db.CreateQueryDef("Q_CSV", "SELECT * FROM t_uke")
    Set qd = Nothing
    
    '--------------------
    ' CSV出力
    '--------------------
    db.QueryDefs![Q_CSV].SQL = strSql
    DoCmd.TransferText acExportDelim, , "Q_CSV", strFilePath, True
    
    '--------------------
    ' QueryDefs削除
    '--------------------
    db.QueryDefs.Delete "Q_CSV"
    
    db.Close 'dbsをクローズ
    Set db = Nothing 'dbsを開放
    
    MsgBox "CSV出力をしました。", vbInformation + vbOKOnly, C_MSG_TITLE
    
Exit Sub
Error:
    MsgBox "エラーが発生しました。エラー内容：" & Err.Description & Chr$(10), vbCritical, C_MSG_TITLE
End Sub