「TOOL_ACCESSデータベース解析_クエリ元項目一覧作成」の編集履歴(バックアップ)一覧はこちら
追加された行は緑色になります。
削除された行は赤色になります。
**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データベース解析]]
[[トップ]]