「TOOL_ACCESSデータベース解析_クエリ一覧作成」の編集履歴（バックアップ）一覧はこちら

「TOOL_ACCESSデータベース解析_クエリ一覧作成」(2013/05/13 (月) 01:35:14) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

**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データベース解析]]

[[トップ]]


　

**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データベース解析]]

[[トップ]]