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

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

• ソース

※追加編集あります

Option Compare Database
Option Explicit

' クエリ元項目一覧作成

' CreateQueryFieldList
' クエリの項目・その元項目を取得する
' 引数：なし
' 引数：戻り値なし
Public Function CreateQueryFieldList()
    ' File
    Dim filePath As String
    ' mdb
    Dim myDb As DAO.Database
    Dim targetDB As DAO.Database
    Dim qdfObj As DAO.QueryDef
    Dim fieldObj As DAO.Field
    Dim strSql As String
    Dim tableName As String
    
    ' sql
'    Dim sqlList As Collection
    Dim sqlNameList As Collection
    Dim sqlTypeList As Collection
    Dim fieldNameList As Collection
    Dim sourceTableList As Collection
    Dim sourceFieldNameList 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 sqlNameList = New Collection
    Set sqlTypeList = New Collection
    Set fieldNameList = New Collection
    Set sourceTableList = New Collection
    Set sourceFieldNameList = New Collection
    
    ListNum = 1
    
    ' sql取得
    For Each qdfObj In targetDB.QueryDefs
        If (Left(qdfObj.Name, 4) <> "MSys") And ((qdfObj.Type = 0) Or (qdfObj.Type = 16)) Then
            
            For Each fieldObj In qdfObj.Fields
                sqlNameList.Add Item:=CStr(qdfObj.Name), Key:=CStr(ListNum)
                sqlTypeList.Add Item:=CStr(qdfObj.Type), Key:=CStr(ListNum)
                fieldNameList.Add Item:=CStr(fieldObj.Name), Key:=CStr(ListNum)
                sourceTableList.Add Item:=CStr(fieldObj.SourceTable), Key:=CStr(ListNum)
                sourceFieldNameList.Add Item:=CStr(fieldObj.SourceField), Key:=CStr(ListNum)
                ListNum = ListNum + 1
            Next fieldObj
            
        End If
    Next qdfObj
    
    ' リスト作成
    ListNum = 0
    tableName = "QueryFieldList"
    Do While sqlNameList.Count <> ListNum
        ListNum = ListNum + 1
        
        strSql = "Insert Into " & tableName & " Values(" & _
                    "'" & sqlNameList.Item(CStr(ListNum)) & "', " & _
                    sqlTypeList.Item(ListNum) & ", " & _
                    "'" & TranslateQueryType(sqlTypeList.Item(ListNum)) & "', " & _
                    "'" & fieldNameList.Item(ListNum) & "', " & _
                    "'" & sourceTableList.Item(ListNum) & "', " & _
                    "'" & sourceFieldNameList.Item(ListNum) & "'" & _
                    ")"
        
        myDb.Execute (strSql)
    Loop
End Function

TOOL_ACCESSデータベース解析

トップ