クエリのSQLを確認する方法

すごく面倒だったのでググったらあったのでメモ。
ついでにファイルじゃなくてテーブルに置きました。

事前準備

  • テーブル「W_TABLE_LIST」の作成
    • TABLE_NAME:文字列型
    • QuerySQL:メモ型
  • クエリのタイトルを全部「Q_〜」にしておく。
    • わかるように統一してあればいいです。

ソース

'各クエリのSQL文をテーブルに格納する関数
Public Sub QueryToSQL()
On Error GoTo Err_QueryToSQL
    Dim strSQL As String

    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset

    Dim Dbs As DAO.Database
    Dim Qdf As DAO.QueryDef

'レコード削除・追加時の警告メッセージOFF
    DoCmd.SetWarnings False

'テーブルのリストを初期化
    strSQL = "DELETE * FROM W_TABLE_LIST"
    DoCmd.RunSQL strSQL

'データベースセット
    Set Dbs = CurrentDb  '実行中テーブルを参照する場合
    'Set Dbs = DAO.OpenDatabase("c:\test.mdb")  '別テーブルを参照する場合はこっちでフルパス指定

'クエリ名を取ってくる、「MsysObjects.Type = 5」でクエリ指定、
'さらに「MsysObjects.Name like "Q_*"」でクエリを絞込み(フォームのレコードソースなどを参照しないようにするため)
    strSQL = "SELECT " & _
                    "MsysObjects.Name " & _
                "FROM " & _
                    "MsysObjects " & _
                "WHERE " & _
                    "MsysObjects.Type = 5 " & _
                    "AND MsysObjects.Name like ""Q_*"""

'レコードセットを回してクエリとSQLを抽出
    Set cnn = CurrentProject.Connection
    rst.Open strSQL, cnn, adOpenStatic, adLockReadOnly

    While rst.EOF = False
        'クエリ名&SQLステートメントをそれぞれ格納するSQLを実行
        '(SQLに「"」が含まれている時は「""」に、改行は半角スペースに置き換え)
        strSQL = "INSERT INTO W_TABLE_LIST(TABLE_NAME, QuerySQL) " & _
                    "VALUES(""" & CStr(Dbs.QueryDefs(CStr(rst("Name").Value)).Name) & """" & _
                            ", """ & Replace( _
                            Replace( _
                                        CStr(Dbs.QueryDefs(CStr(rst("Name").Value)).SQL) _
                                        , """" _
                                        , """""" _
                                    ) _
                                    , vbNewLine _
                                    , " " _
                            ) & """" & _
                            ")"
        DoCmd.RunSQL strSQL
        rst.MoveNext
    Wend

'結果見たいからテーブル初期化しない

Exit_QueryToSQL:
'レコードセットの終了、DBのリセット、レコード削除・追加時の警告メッセージON、処理完了
    rst.Close
	cnn.Close
    Set rst = Nothing
    Set Dbs = Nothing
    DoCmd.SetWarnings True
    Exit Sub

Err_QueryToSQL:
    MsgBox Err.Description
    Resume Exit_QueryToSQL

End Sub