【Access/VBA】データベース定義書の素材テーブルを更新する

自分用。
大した内容じゃないからまた作れるんだけど、そんなの面倒くさいじゃないのさ…。

Option Compare Database
Option Explicit

'==============================
'　write by m_o_co
'==============================

Public Sub TBL_Name_Prt()
'==============================
' テーブル名だけ欲しい時向け
' インディミエイトウィンドへ書き出します
'==============================
Dim DBC As DAO.Database
Dim TBLs As DAO.TableDefs
Dim wkOBJ As DAO.TableDef

　　Set DBC = CurrentDb
　　Set TBLs = DBC.TableDefs

　　For Each wkOBJ In TBLs
　　　　If Not wkOBJ.Name Like "MSys*" And Not wkOBJ.Name Like "~*" Then
　　　　
　　　　　　Debug.Print wkOBJ.Name
　　　　
　　　　End If
　　Next

　　Set TBLs = Nothing: Set wkOBJ = Nothing
　　DBC.Close
　　
End Sub
Public Sub TBL_Kousei()
'==============================
' テーブル構成を収集し、指定のテーブルへDellAdd
'==============================
Const M_TBL_Name As String = "テーブル構成情報収集"
Dim TBLs As DAO.TableDefs
Dim wkOBJ As DAO.TableDef
Dim wkOBJ2 As DAO.Field
Dim DBC As DAO.Database
Dim RS As DAO.Recordset
Dim wkTBL_Name As String

　　Set DBC = CurrentDb
　　DBC.Execute "delete from " & M_TBL_Name
　　Set RS = DBC.OpenRecordset(M_TBL_Name, dbOpenDynaset)
　　Set TBLs = DBC.TableDefs

　　For Each wkOBJ In TBLs
　　　　If Not wkOBJ.Name Like "MSys*" And Not wkOBJ.Name Like "~*" Then
　　　　
　　　　　　wkTBL_Name = wkOBJ.Name
　　　　　　
　　　　　　For Each wkOBJ2 In wkOBJ.Fields
　　　　　　　　RS.AddNew
　　　　　　　　　　RS!テーブル名 = wkTBL_Name
　　　　　　　　　　RS!項目名 = wkOBJ2.Name
　　　　　　　　　　RS!タイプ名 = DBtype_String(wkOBJ2.Type)
　　　　　　　　　　RS!サイズ = wkOBJ2.Size
　　　　　　　　　　RS!タイプ = wkOBJ2.Type
　　　　　　　　RS.Update
　　　　　　Next
　　　　
　　　　End If
　　Next

　　RS.Close
　　Set TBLs = Nothing: Set wkOBJ2 = Nothing: Set wkOBJ = Nothing
　　DBC.Close
End Sub
Public Function DBtype_String(Fld_Parm As Double) As String

　　Select Case Fld_Parm
　　Case dbBoolean
　　　　DBtype_String = "Yes/No型"
　　Case dbText
　　　　DBtype_String = "テキスト型"
　　Case dbMemo
　　　　DBtype_String = "メモ型"
　　Case dbByte
　　　　DBtype_String = "バイト型"
　　Case dbInteger
　　　　DBtype_String = "整数型"
　　Case dbLong
　　　　DBtype_String = "長整数型"
　　Case dbSingle
　　　　DBtype_String = "単精度浮動小数点型"
　　Case dbDouble
　　　　DBtype_String = "倍精度浮動小数点型"
　　Case dbDate
　　　　DBtype_String = "日付/時刻型"
　　Case dbCurrency
　　　　DBtype_String = "通貨型"
　　Case dbAutoIncrField
　　　　DBtype_String = "オートナンバー型"
　　Case dbLongBinary
　　　　DBtype_String = "OLE オブジェクト型"
'　　Case dbHyperLink
'　　　　DBtype_String = "ハイパーリンク型"
　　Case Else
　　　　DBtype_String = Fld_Parm
　　End Select

End Function
Public Sub Get_Qry_Name_and_String()
'==============================
' クエリの内容を収集する
' テーブルは面倒なので兼用
'==============================
Const M_TBL_Name As String = "テーブル構成情報収集"
Dim Qrys As DAO.QueryDefs
Dim wkOBJ As DAO.QueryDef
Dim DBC As DAO.Database
Dim RS As DAO.Recordset

　　Set DBC = CurrentDb
　　DBC.Execute "delete from " & M_TBL_Name
　　Set RS = DBC.OpenRecordset(M_TBL_Name, dbOpenDynaset)
　　Set Qrys = DBC.QueryDefs

　　For Each wkOBJ In Qrys
　　　　If Not wkOBJ.Name Like "~sq_*" Then

　　　　　　RS.AddNew
　　　　　　　　RS!テーブル名 = wkOBJ.Name
　　　　　　　　RS!クエリSQL = wkOBJ.SQL
　　　　　　RS.Update
　　　　　　
　　　　End If
　　Next

　　RS.Close
　　Set Qrys = Nothing: Set wkOBJ = Nothing
　　DBC.Close
End Sub