TOOL_ACCESSデータベース解析_クエリ一覧作成 - toolstorage

TOOL_ACCESSデータベース解析_クエリ一覧作成

• ソース

※追加編集あります

Option Compare Database
Option Explicit

Public Function CreateQueryList()
    ' File
    Dim filePath As String
    ' mdb
    Dim myDb As DAO.Database
    Dim targetDB As DAO.Database
    Dim qdfObj As DAO.QueryDef
    Dim strSql As String
    Dim tableName As String
    
    ' sql
    Dim sqlList As Collection
    Dim sqlNameList As Collection
    Dim sqlTypeList As Collection
    Dim ListNum As Long
    
    ' dialog
    Dim ExpDiaObj As ACC_ExploreDialogObject
    
    ' Check
    Dim CAFObj As ACC_CheckAccessFile
    
    ' 初期化
    Set ExpDiaObj = New ACC_ExploreDialogObject
    Set CAFObj = New ACC_CheckAccessFile
    
    ' ファイルパス取得
    filePath = ExpDiaObj.SelectFilePathWithDialog
    
    If CAFObj.IsAccessDBFile(filePath) <> True Then
        MsgBox "ファイル名に入力不備がありました。処理を中断します"
        Exit Function
    End If
    
    ' mdbへの接続
    Set myDb = CurrentDb
    Set targetDB = Application.DBEngine.OpenDatabase(Name:=filePath)
    Set sqlList = New Collection
    Set sqlNameList = New Collection
    Set sqlTypeList = New Collection
    
    ListNum = 1
    
    ' sql取得
    For Each qdfObj In targetDB.QueryDefs
        If Left(qdfObj.Name, 4) <> "MSys" Then
            sqlList.Add Item:=CStr(qdfObj.SQL), Key:=CStr(ListNum)
            sqlNameList.Add Item:=CStr(qdfObj.Name), Key:=CStr(ListNum)
            sqlTypeList.Add Item:=CStr(qdfObj.Type), Key:=CStr(ListNum)
            ListNum = ListNum + 1
        End If
    Next qdfObj
    
    ' リスト作成
    ListNum = 0
    tableName = "QueryList"
    Do While sqlList.Count <> ListNum
        ListNum = ListNum + 1
        strSql = "Insert Into " & tableName & " Values(" & _
                    "'" & sqlNameList.Item(CStr(ListNum)) & "', " & _
                    "'" & sqlList.Item(CStr(ListNum)) & "', " & _
                    sqlTypeList.Item(ListNum) & ", " & _
                    "'" & TranslateQueryType(sqlTypeList.Item(ListNum)) & "'" & _
                    ")"
        
        myDb.Execute (strSql)
    Loop
End Function

Public Function TranslateQueryType(ByVal iQType As Long) As String
    Dim strTypeName As String
    
    If iQType = 0 Then
        ' dbQSelect
        strTypeName = "選択クエリ"
    ElseIf iQType = 16 Then
        ' dbQCrosstab
        strTypeName = "クロス集計クエリ"
    ElseIf iQType = 32 Then
        ' dbQDelete
        strTypeName = "削除クエリ"
    ElseIf iQType = 48 Then
        ' dbQUpdate
        strTypeName = "更新クエリ"
    ElseIf iQType = 64 Then
        ' dbQAppend
        strTypeName = "追加クエリ"
    ElseIf iQType = 80 Then
        ' dbQMakeTable
        strTypeName = "テーブル作成クエリ"
    ElseIf iQType = 96 Then
        ' dbQDDL
        strTypeName = "DDL (データ定義言語) クエリ"
    ElseIf iQType = 112 Then
        ' dbQSQLPassThrough
        strTypeName = "SQL パススルー クエリ"
    ElseIf iQType = 128 Then
        ' dbQSetOperation
        strTypeName = "ユニオンクエリ"
    ElseIf iQType = 144 Then
        ' dbQSPTBulk
        strTypeName = "一括操作クエリ"
    ElseIf iQType = 160 Then
        ' dbQCompound
        strTypeName = "複合クエリ"
    ElseIf iQType = 224 Then
        ' dbQProcedure
        strTypeName = "ストアド プロシージャを実行する SQL プロシージャ"
    ElseIf iQType = 240 Then
        ' dbQAction
        strTypeName = "アクション クエリ"
    Else
        strTypeName = "Not Found : " & CStr(iQType)
    End If
    
    TranslateQueryType = strTypeName
End Function

TOOL_ACCESSデータベース解析

トップ