３．標準モジュール
3.1 共通処理
3.1.1 initSet（初期設定）
Option Compare Database
Option Explicit
Option Base 1
'
'CGetTypeで使用する共通変数
Public cType As Integer 'DataType
Public cAttributes As Long 'Attribute
Public cResultType As Long 'ResultType (>0は集計）
Public cDisplayControl As Long 'DisplayControl
Public cRowSourceType As String 'RowSourceType
Public TypeConst(115, 3) As String 'DataType Table
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' initSet (AutoExecマクロに登録)
'------------------------------------------------
Public Function initSet()
'Data型テーブルのセット
Erase TypeConst '初期化
'
TypeConst(1, 1) = "Yes/No": TypeConst(1, 2) = "(集計) Yes/No"
TypeConst(2, 1) = "バイト"
TypeConst(3, 1) = "整数": TypeConst(3, 2) = "(集計) 整数"
TypeConst(4, 1) = "長整数": TypeConst(4, 2) = "(集計) 長整数": TypeConst(4, 3) = "オートナンバー"
TypeConst(5, 1) = "通貨": TypeConst(5, 2) = "(集計) 通貨"
TypeConst(6, 1) = "単精度小数点": TypeConst(6, 2) = "(集計) 単精度小数点"
TypeConst(7, 1) = "倍精度小数点": TypeConst(7, 2) = "(集計) 倍精度小数点"
TypeConst(8, 1) = "日付／時刻型": TypeConst(8, 2) = "(集計) 日付／時刻型"
TypeConst(10, 1) = "短いテキスト": TypeConst(10, 2) = "(集計) 短いテキスト"
TypeConst(11, 1) = "OLE オブジェクト型"
TypeConst(12, 1) = "長いテキスト": TypeConst(12, 2) = "ハイパーリンク"
TypeConst(15, 1) = "レプリケーションID": TypeConst(15, 2) = "(集計) レプリケーションID"
TypeConst(16, 1) = "大きい数値": TypeConst(16, 2) = "(集計) 大きい数値"
TypeConst(20, 1) = "十進": TypeConst(20, 2) = "(集計) 十進"
TypeConst(26, 1) = "拡張した日付／時刻": TypeConst(26, 2) = "(集計) 拡張した日付／時刻"
'
TypeConst(101, 1) = "添付ファイル"
'
TypeConst(110, 1) = "リストボボックス"
TypeConst(111, 1) = "コンボボックス"
'
'DBのテーブルの初期化
CurrentDb.Execute ("delete * from T_DB") 'T_DB clear
CurrentDb.Execute ("delete * from T_TB") 'T_TB clear
CurrentDb.Execute ("delete * from T_FLD") 'T_FLD clear
CurrentDb.Execute ("delete * from T_IX") 'T_IX clear
CurrentDb.Execute ("delete * from T_IXFLD") 'T_IXFLD clear
End Function
①Public で宣言している変数は、3.1.2 CGetType で使用する共通変数です。
Option Base 1：テーブルのインデックスを１からの開始に変更しています。
（宣言しなければゼロからの開始になります）
③initSet Functionでは、当DBの全テーブルの初期化を行っています。
④TypeConstで登録している値は、フィールドプロパティの調査を参照して下さい。
Erase TypeConstは、テーブルの初期化です。
⑤このファンクションは起動時に実行させるようにしています。
そのため、マクロ登録をしてマクロ名を「AutoExec」変更しています。
「AutoExec」マクロはDBの起動時にすべての処理に先立って実行されます。
3.1.2 CGetType(データ型の取得）
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' データ型の取得
'------------------------------------------------
Public Function CGetType()
'
Dim n1 As Integer
Dim n2 As Integer
'
If cRowSourceType <> "" Then 'RowSourceType<>"" ルックアップ
If cType <> 16 Then
If cDisplayControl = 110 Then 'DisplayControl =110 リストボックス
n1 = 110: n2 = 1
End If
If cDisplayControl = 111 Then 'DisplayControl =111 コンボボックス
n1 = 111: n2 = 1
End If
GoTo ex1
End If
End If
n1 = cType: n2 = 1 '
If cResultType > 0 Then n2 = 2 'ResultType> 0 は 集計
'
If cType = 4 And cAttributes > 10 Then n2 = 3 'Type=4,Attributes=17 オートナンバー
If cType = 12 And cAttributes > 10 Then n2 = 2 'Type=12,Attributes=32770 ハイパーリンク
ex1:
CGetType = TypeConst(n1, n2)
'
End Function
①ここで使用している以下の変数
cType(DataType)、cAttributes(Attribute)、cResultType(ResultType (>0は集計）
cDisplayControl(DisplayControl)、cRowSourceType(RowSourceType)
は、呼び出し側で事前に値をセットしてます。
プロジェクトで共通で使用するため、モジュールの先頭でPublic 宣言しています。
②CGettype=TypeConst(n1,n2)
TypeConstテーブルから、該当するデータ型を返しています。
3.1.3 GetAD （並び順を日本語に変換）
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 並び順（昇順か降順か）を日本語に変換
'------------------------------------------------
'n1=IndexKeyfld.Attributes
'
Public Function GetAD(n1 As Integer) As String
If n1 = 0 Then
GetAD = "昇順"
Else
GetAD = "降順"
End If
End Function
①引数の「IndexKeyfld.Attributes」はインデックスの構成フィールドのプロパティです。
「昇順」か「降順」の文字を返します。
3.1.4 GetYesNo （Booleanの値を日本語に変換）
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Booleanの値(TrueかFalse）を日本語に変換
'------------------------------------------------
'n1=IndexKey.Primary(unique,IgnoreNulls)
'
Public Function GetYesNo(n1 As Boolean) As String
If n1 = True Then
GetYesNo = "はい"
Else
GetYesNo = "いいえ"
End If
End Function
①引数の「IndexKey.Primary」（他、unique、IgnoreNulls）は、
インデックスのプロパティです。「はい」か「いいえ」を返します。
3.2 テーブルへの保存（１）
3.2.1 DBSave（データベース情報の保存）
'-------------------------------------------------
' DB情報保存 （T_DB)
'-------------------------------------------------
Public Sub DBSave(ByVal fname As String, ByVal rs As Recordset, ByVal ID As Integer)
'
Dim ix1 As Integer
Dim wk1 As String
Dim wk2 As String
'
ix1 = InStrRev(fname, "\", , vbTextCompare) 'DBfile名の開始カラム検索
wk1 = Right$(fname, Len(fname) - ix1) 'file名を抽出
wk2 = Left$(fname, ix1 - 1) 'Pathを抽出
'
rs.AddNew 'T_DBに新規追加
rs![DB_ID] = ID '=1 のみ（引数=1)
rs![DB_Name] = wk1 'File名保存
rs![DB_Path] = wk2 'Path保存
rs.Update 'T_DB更新
End Sub
①フォームの呼び出しコードは、DBSave(Me.DBFile, rsdb, 1) です。
「rsDB」は「T_DB」のRecordset です。 IDは 1 です。
②ファイル名を名前とパスに分けて「T_DB」に新規登録します。
特に分ける必要はありませんが、印刷レイアウトの設計で分けているからです。
3.2.2 TBSave（テーブル情報の保存）
'-------------------------------------------------
' テーブル情報保存 (T_TB)
'-------------------------------------------------
Public Sub TBSave(ByVal obj As Object, ByVal rs As Recordset, ByVal ID As Integer)
'
rs.AddNew 'T_TB に新規追加
rs![TB_TableID] = ID 'TableID
rs![TB_Name] = obj.Name
'
rs![TB_Connect] = ""
rs![TB_SourceTable] = ""
rs![TB_Description] = ""
'
On Error Resume Next 'エラー発生時は無視（次行へ）
rs![TB_Connect] = obj.Connect 'LinkDB
rs![TB_SourceTable] = obj.SourceTableName 'Link元Table名
rs![TB_Description] = obj.Properties("Description") '説明文
On Error GoTo 0 'エラー発生無視を解除
'
rs.Update 'T_TBテーブルの更新
End Sub
①フォームの呼び出しコードは、TBSave(ixtable, rsTB, TableID) です。
「ixtable」は、DBのTabledefsコレクション内のテーブル定義オブジェクトです。
「rsTB」は「T_TB」のRecordset です。
「TableID」は「T_TB」のインデックスキーです。
②テーブル名とID、リンクテーブルの場合はリンク元情報を「T_TB」に保存します。
③Localテーブルの場合は、「Connect」 等のプロパティ値は設定されていませんので、
エラーになります。そのため、あらかじめ空白（””）にしてから、
「On Error Resume Next」で、エラーの場合はそのまま次行に進み、最後に
「ON Error Goto 0」で、エラーの無視を解除しています。
４．クラスモジュール
4.1 テーブルへの保存（２）
4.1.1 cxFLDSave（フィールドとインデックス情報の保存）
(1) DB名とTable名の代入
'-------------------------------------------------
' フィールド情報とインデックス情報の保存
'-------------------------------------------------
Option Compare Database
Option Explicit
'
Private cdb As String
Private ctab As String
'------------------------------------------------
Public Property Let dbname(ByVal value As String) 'DataBase名
cdb = value
End Property
'------------------------------------------------
Public Property Let tabname(ByVal value As String) 'Table名
ctab = value
End Property
'------------------------------------------------
①Let dbname：データベース名にプロパティ値を代入します。
②Let tabname：テーブル名にプロパティ値を代入します。
(2) フィールド情報の保存
Public Sub cxFLDSave(ByVal rs1 As Recordset, ByVal rs2 As Recordset, ByVal rs3 As Recordset, ByVal ID As Integer)
'r1=rsFLD,r2=rsIX,r3=rsIXFLD,ID=TableID
Dim db1 As DAO.Database
Set db1 = DBEngine.Workspaces(0).OpenDatabase(cdb)
'-------------------------------------------------
' フィールド情報を登録 (T_FLD)
'-------------------------------------------------
Dim fieldID As Integer
Dim ixfld As DAO.Field
'
fieldID = 0 'フィールドのCounter
'tableのフィールドを検索
For Each ixfld In db1.TableDefs(ctab).Fields 'フィールドを検索
fieldID = fieldID + 1 'Fieldのカウント＋１
rs1.AddNew 'T_FLD 新規追加
rs1![FLD_TableID] = ID 'ID=TableID
rs1![FLD_FieldID] = fieldID 'FieldID
rs1![FLD_Name] = ixfld.Name 'FieldName
'
On Error Resume Next 'エラー発生時は無視（次行へ）
cDisplayControl = 0 '初期値登録
cResultType = 0
cRowSourceType = ""
'
cDisplayControl = ixfld.Properties("DisplayControl") 'Lookupの判定のため
cResultType = ixfld.Properties("ResultType") 'ResultType>0： 集計
cRowSourceType = ixfld.Properties("RowSourceType") 'ルックアップ判定のため
cType = ixfld.Type 'データ型
cAttributes = ixfld.Attributes
rs1![FLD_Type] = CGetType 'データ型検索(Function)
'
rs1![FLD_Description] = "" '
rs1![FLD_ValidationRule] = "" '
rs1![FLD_Description] = ixfld.Properties("Description") '説明文
rs1![FLD_ValidationRule] = ixfld.ValidationRule '入力規則
On Error GoTo 0 'エラー発生無視を解除
rs1.Update 'T_FLD 更新
Next ixfld
① 呼び出しコードは、cls.cxFLDSave(rsFLD, rsIX, rsIXFLD,TableID) です。
rsFLDは、「T_FLD」のRecordSet、rsIXは「T_IX」のRecordset、
rsIXFLは「T_IXFLD」のRecordset、TableIDはTableの「ID」 です。
「TableID」は「T_TB」のインデックスキーです
②Set db1 = DBEngine.Workspaces(0).OpenDatabase(cdb)
データベース(cdb)を開きます。
③テーブル（ctab)定義オブジェクト内のフィールドコレクションを検索します。
④フィールドのデータ型を「CGetType」から取得して、「T_FLD」に保存しています。
⑤「CGetType」で使用するプロパティや、フィールドの説明文など、設定されていない
場合にはエラーになります。そのため、あらかじめ空白（””）にしてから、
「On Error Resume Next」で、次行にそのまま進み（エラーを無視）、最後に
「ON Error Goto 0」で、エラーの無視を解除しています。
(3) インデックス情報の保存
'-------------------------------------------------
' インデックス情報を登録 (T_IX)
'-------------------------------------------------
Dim ixid As Integer
Dim seq As Integer
Dim indexkey As DAO.Index
Dim indexkeyfld As DAO.Field
'
ixid = 0 'IndexのCount№
For Each indexkey In db1.TableDefs(ctab).Indexes 'テーブルのインデックスを検索
ixid = ixid + 1 'IndexID + 1
rs2.AddNew 'T_IX 新規追加
rs2![IX_TableID] = ID 'ID=TableID
rs2![IX_IndexID] = ixid 'IndexID
rs2![IX_Name] = indexkey.Name 'Index名
'
rs2![IX_Primary] = GetYesNo(indexkey.Primary) '主キーか否か
rs2![IX_unique] = GetYesNo(indexkey.Unique) '固有か否か
rs2![IX_IgnoreNulls] = GetYesNo(indexkey.IgnoreNulls) 'Null無視か否か
rs2.Update
①db1（Database）の ctab（Table）のインデックスコレクションから、
インデックス情報を「T_IX」に保存します。
②「GetYesNo」 でインデックスのプロパティを日本語に変換しています。
(4)インデックスの構成フィールドの保存
'-------------------------------------------------
' インデックスキーの構成フィールドを登録(T_IXFLD)
'-------------------------------------------------
seq = 0 'インデックスの構成順
For Each indexkeyfld In db1.TableDefs(ctab).Indexes(indexkey.Name).Fields
seq = seq + 1 'Seq+1
rs3.AddNew 'T_IXFLD 新規追加
rs3![IXFLD_TableID] = ID 'ID=TableID
rs3![IXFLD_IndexID] = ixid 'IndexID
rs3![IXFLD_Seq] = seq '構成順
rs3![IXFLD_Name] = indexkeyfld.Name '構成フィールド名
rs3![IXFLD_AD] = GetAD(indexkeyfld.Attributes) '昇順か降順か
rs3.Update 'T_IXFLD更新
Next indexkeyfld '
Next indexkey '
'
db1.Close
Set db1 = Nothing
End Sub
③続いて、インデックスの構成フィールドを検索し、「T_IXFLD」に保存します。
④「GetAD」でフィールドの並び順を日本語に変換しています。
’————–
ここまでが1件の index定義オブジェクトの処理です。
インデックスとインデックスの構成フィールドを各テーブルに保存しています。
⑤最後にデータベースを閉じてオブジェクトを解放します。
前回の「テーブル定義書の作成」でも同じような説明をしていますので併せて御覧下さい。
次回は、レポートの作成手順をご紹介したいと思います。
