※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

TOOL_ACCESSデータベース解析_初回準備

  • ソース
※追加編集あります
Option Compare Database
Option Explicit

Public Sub 初回起動時準備()
    テーブル作成_テーブル定義
    テーブル作成_クエリ一覧
End Sub

Private Function テーブル作成_テーブル定義()
    Dim ACC_CheckAFObj As ACC_CheckAccessFile
    Dim dbObj As DAO.Database
    Dim dbTblDef As DAO.TableDef
    Dim tableName As String
    
    ' DB・チェッククラスの初期化
    Set ACC_CheckAFObj = New ACC_CheckAccessFile
    Set dbObj = CurrentDb
    
    ' 作成するテーブル名
    tableName = "TableAndFieldList"
    
    ' 1.テーブルが既に存在する場合削除
    If ACC_CheckAFObj.HasSelectedTable(dbObj, tableName) <> False Then
        dbObj.TableDefs.Delete tableName
    End If
    
    ' 2.新規テーブルの定義作成
    Set dbTblDef = dbObj.CreateTableDef(tableName)
    
    dbTblDef.Fields.Append dbTblDef.CreateField("TableName", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("FieldName", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("FieldType", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("FieldSize", dbInteger)
    
    ' 3.新規テーブルの作成
    dbObj.TableDefs.Append dbTblDef
End Function

Private Function テーブル作成_クエリ一覧()
    Dim ACC_CheckAFObj As ACC_CheckAccessFile
    Dim dbObj As DAO.Database
    Dim dbTblDef As DAO.TableDef
    Dim tableName As String
    
    ' DB・チェッククラスの初期化
    Set ACC_CheckAFObj = New ACC_CheckAccessFile
    Set dbObj = CurrentDb
    
    ' 作成するテーブル名
    tableName = "QueryList"
    
    ' 1.テーブルが既に存在する場合削除
    If ACC_CheckAFObj.HasSelectedTable(dbObj, tableName) <> False Then
        dbObj.TableDefs.Delete tableName
    End If
    
    ' 2.新規テーブルの定義作成
    Set dbTblDef = dbObj.CreateTableDef(tableName)
    
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryName", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("SQL", dbMemo)
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryType", dbInteger)
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryTypeText", dbText)
    
    ' 3.新規テーブルの作成
    dbObj.TableDefs.Append dbTblDef
End Function

Private Function テーブル作成_クエリ操作項目()
    Dim ACC_CheckAFObj As ACC_CheckAccessFile
    Dim dbObj As DAO.Database
    Dim dbTblDef As DAO.TableDef
    Dim tableName As String
    
    ' DB・チェッククラスの初期化
    Set ACC_CheckAFObj = New ACC_CheckAccessFile
    Set dbObj = CurrentDb
    
    ' 作成するテーブル名
    tableName = "QueryFieldList"
    
    ' 1.テーブルが既に存在する場合削除
    If ACC_CheckAFObj.HasSelectedTable(dbObj, tableName) <> False Then
        dbObj.TableDefs.Delete tableName
    End If
    
    ' 2.新規テーブルの定義作成
    Set dbTblDef = dbObj.CreateTableDef(tableName)
    
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryName", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryType", dbInteger)
    dbTblDef.Fields.Append dbTblDef.CreateField("QueryTypeText", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("FieldName", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("SourceTable", dbText)
    dbTblDef.Fields.Append dbTblDef.CreateField("SourceFieldName", dbText)
    
    ' 3.新規テーブルの作成
    dbObj.TableDefs.Append dbTblDef
End Function

Private Function フォーム作成()
    Dim mForm As Form
    
    Dim AdjustSize As Long
    AdjustSize = 567    ' 567twip = 1cm
    
    ' 1.フォームの動的生成
    Set mForm = CreateForm
    
    ' 2.フォームの設定
    ' フォームの種類
    mForm.DefaultView = 0
    ' フォームの縦横のサイズ
    '単位:twip
    mForm.Section(0).Height = 12 * AdjustSize
    mForm.Width = 8 * AdjustSize
    '標題
    mForm.Caption = "MDB解析フォーム"
    'レコードセレクタ
    mForm.RecordSelectors = False
    ' 表示設定
    mForm.Visible = True
'    mForm.OnLoad = "=FormFormat()"
    
    ' 3.パーツ付与
    Call パーツ設定(mForm, AdjustSize)
    
    ' 4.フォームのサイズを戻す
    DoCmd.Restore
    
    ' 5.フォームを開く
    DoCmd.OpenForm mForm.Name, acDesign
    ' 6.フォームのウィンドウ位置とサイズを修正
    DoCmd.MoveSize 0, 0, 9 * AdjustSize, 12 * AdjustSize
    
    ' 7.フォームを保存
    DoCmd.Save , "ファイル情報取得フォーム"
    
    ' 8.フォームを閉じる
    DoCmd.Close , , acSaveNo
    
End Function

Private Function パーツ設定(ByVal iForm As Form, ByVal iAS As Long)
    
    Dim LabelTitleObj As Control
    Dim BtnCreateQueryListObj As Control
    Dim BtnCreateQueryFieldListObj As Control
    
    ' 1.タイトルラベルの設定
    Set LabelTitleObj = CreateControl(iForm.Name, acLabel, , , , 0.25 * iAS, 0.5 * iAS)
    LabelTitleObj.Name = "フォームタイトル"
    LabelTitleObj.Width = 6 * iAS
    LabelTitleObj.Height = 1 * iAS
    LabelTitleObj.Caption = "指定Accessファイルのテーブル・クエリ情報を取得・リスト化します"
    LabelTitleObj.FontSize = 10
    
    ' 2.クエリ一覧作成ボタンの設定
    Set BtnCreateQueryListObj = CreateControl(iForm.Name, acCommandButton, , , "クエリ一覧作成ボタン", 2 * iAS, 1.5 * iAS, 4 * iAS)
    BtnCreateQueryListObj.Caption = "クエリ一覧作成"
    BtnCreateQueryListObj.Height = 1 * iAS
    BtnCreateQueryListObj.OnClick = "=CreateQueryList()"

    ' 3.クエリ元項目ボタンの設定
    Set BtnCreateQueryFieldListObj = CreateControl(iForm.Name, acCommandButton, , , "クエリ元項目一覧ボタン", 2 * iAS, 3.5 * iAS, 4 * iAS)
    BtnCreateQueryFieldListObj.Caption = "クエリ元項目一覧作成"
    BtnCreateQueryFieldListObj.Height = 1 * iAS
    BtnCreateQueryFieldListObj.OnClick = "=CreateQueryFieldList()"
End Function