まりふのひと

ADOX で新しいクエリーを作成する

ADOでは、確かクエリーは作れない」との記憶から、以前作成した Access やヘルプを捜していたが、VBでデータベースで見つかった。早速、試したところ、グー!
行方不明になってはいけないので、引用させていただく。

Option Explicit
Private Sub cmdCreateQuery_Click()
' この例では既存データベースに新しいクエリーを追加します。
    
    Dim strDatabase As String
    Dim strConnect As String
    Dim strSQL As String
          
    Dim cmd As ADODB.Command
    Dim cat As ADOX.Catalog
    
    ' 既存データベース名を指定する
    strDatabase = "C:\Program Files\DevStudio\VB\BIBLIO.MDB"
    ' 接続文字列を設定する
    strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & strDatabase & ";"
    ' 接続文字列もしくはConnectionオブジェクトを指定する
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = strConnect
    ' クエリーとして保存する任意のSQL文を指定する
    strSQL = "SELECT COUNT(*) AS 出版数,[Year Published] " & _
             "FROM Titles GROUP BY [Year Published]"
    ' クエリーをCommandオブジェクトに設定
    Set cmd = New ADODB.Command
    cmd.CommandText = strSQL
    ' 名前を指定してクエリーを追加する
    cat.Views.Append "年別出版数", cmd

    ' 既存のクエリーを削除する場合以下の行を使用する
    'cat.Views.Delete "年別出版数"

    ' 既存のクエリーを修正する場合以下の行を使用する
    'cat.Views.Item("年別出版数").Command = cmd
    
End Sub

実際に作ったモジュールは、次のとおり。

Option Compare Database
Option Explicit
Const MYObjName As String = "modMake_Query"

'概要:ADOXを使って、SQLからクエリーを作る。
'履歴:H17.08.11    初版
Public Function Make_Query(argQueryName As String, argSQLCmd As String) As Boolean
On Error GoTo Err_Make_Query
Dim mbTitle As String
Dim CNN As New ADODB.Connection
Dim CMD As ADODB.Command
Dim CAT As ADOX.Catalog

    mbTitle = MYObjName & "/Make_Query"
    Set CNN = CurrentProject.Connection
    Set CAT = New ADOX.Catalog
    CAT.ActiveConnection = CNN
    Set CMD = New ADODB.Command
    CMD.CommandText = argSQLCmd
        ' 既存のクエリーを置き換える
    CAT.Views.Item(argQueryName).Command = CMD
    Make_Query = True
    
Exit_Make_Query:
    DoEvents
    Set CMD = Nothing
    Set CAT = Nothing
    Set CNN = Nothing
    Exit Function
    
Err_Make_Query:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_Make_Query
End Function