忍者ブログ
03 July

[PR]

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

25 December

【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

拍手

PR