Posted By

qrist0ph on 06/19/08


Tagged

access vba


Versions (?)

Access Data Dictionary Erstellen


 / Published in: Visual Basic
 

  1. Attribute VB_Name = "DataDictionary"
  2. Option Compare Database
  3. 'erstellt ein data dictionary aus einer access datenbank
  4.  
  5. Sub createDataDictionary()
  6. On Error Resume Next
  7. DoCmd.SetWarnings False
  8. createDBSchema
  9. strSql = "delete * from data_dictionary"
  10. DoCmd.RunSQL strSql
  11.  
  12. For Each q In CurrentDb.QueryDefs
  13. exportQuery q.Name
  14. Next
  15.  
  16. For Each t In CurrentDb.TableDefs
  17. exportTable t.Name
  18. Next
  19.  
  20. exportReports
  21. DoCmd.SetWarnings True
  22. End Sub
  23.  
  24. Sub exportQuery(queryName As String)
  25. Dim q As QueryDef
  26. Dim f As Field
  27. Set q = CurrentDb.QueryDefs(queryName)
  28. queryName = q.Name
  29.  
  30. 'die id der abfrage aus MSysObjects holen
  31. strSql = "Select Id from MSysObjects where Name='" & q.Name & "' AND type=5;"
  32. Dim rs As Recordset
  33. Set rs = CurrentDb.OpenRecordset(strSql)
  34. objectID = rs!Id
  35.  
  36. 'fuer jedes feld der query
  37. c = 0
  38. For Each f In q.Fields
  39.  
  40. sqlInsert = "INSERT INTO data_dictionary ([type],[table_name],[field_name],[datatype],[ordinal_position],[ObjectId],[source_table],[source_field]) VALUES ('query','" & q.Name & "','" & f.Name & "'," & f.Type & "," & c & "," & objectID & ",'" & f.SourceTable & "','" & f.SourceField & "');"
  41. DoCmd.RunSQL sqlInsert
  42. c = c + 1
  43. Next
  44.  
  45. 'integration der Werte aus MSysQueries
  46. strSql = "UPDATE data_dictionary INNER JOIN MSysQueries ON (MSysQueries.Name1 = data_dictionary.field_name) AND (data_dictionary.ObjectId = MSysQueries.ObjectId) SET data_dictionary.expression = [MSysQueries]![Expression];"
  47. DoCmd.RunSQL strSql
  48.  
  49. End Sub
  50.  
  51.  
  52. Sub createDBSchema()
  53. sqlCreate = "CREATE TABLE data_dictionary ([id] COUNTER CONSTRAINT ndxStaffID PRIMARY KEY, [type] TEXT(25),[table_name] TEXT(255), [field_name] TEXT(25),[datatype] integer,[ordinal_position] integer, [ObjectId] integer,[source_table] TEXT(255),[source_field] TEXT(255),[expression] TEXT(255))"
  54. DoCmd.RunSQL sqlCreate
  55.  
  56. End Sub
  57.  
  58.  
  59. 'exportiert tabellen ins data dictionary
  60. Sub exportTable(tableName As String)
  61. Dim tblDef As TableDef
  62. Dim f As Field
  63. Set db = CurrentDb()
  64. Set tblDef = db.TableDefs(tableName)
  65.  
  66. 'die id der abfrage aus MSysObjects holen
  67. strSql = "Select Id from MSysObjects where Name='" & tblDef.Name & "' AND type=1;"
  68. Dim rs As Recordset
  69. Set rs = CurrentDb.OpenRecordset(strSql)
  70. objectID = rs!Id
  71.  
  72. 'fuer jedes feld der tabelle
  73. c = 0
  74. For Each f In tblDef.Fields
  75.  
  76. sqlInsert = "INSERT INTO data_dictionary ([type],[table_name],[field_name],[datatype],[ordinal_position],[ObjectId],[source_table],[source_field]) VALUES ('table','" & tblDef.Name & "','" & f.Name & "'," & f.Type & "," & c & "," & objectID & ",'" & f.SourceTable & "','" & f.SourceField & "');"
  77. DoCmd.RunSQL sqlInsert
  78. c = c + 1
  79. Next
  80.  
  81. End Sub
  82.  
  83. Sub exportReports() 'Optional reportName As String
  84. Dim rpt As Report, ctl As Control
  85. Dim rs As Recordset
  86. strSql = "Select id,Name from MSysObjects WHERE Type=-32764"
  87. Set rs = CurrentDb.OpenRecordset(strSql)
  88. On Error Resume Next
  89. Do While Not rs.EOF
  90. DoCmd.OpenReport rs!Name, acViewPreview
  91. Set rpt = Reports(rs!Name)
  92. ' Name des Berichts ausgeben.
  93. Debug.Print rpt.Name
  94. ' Controls-Auflistung jedes Berichts durchlaufen.
  95. For Each ctl In rpt.Controls
  96. If ctl.ControlType = acTextBox Then
  97. Debug.Print ctl.Name & ": " & ctl.Properties(3)
  98. sqlInsert = "INSERT INTO data_dictionary ([type],[table_name],[field_name],[ObjectId],[expression]) VALUES ('report','" & rs!Name & "','" & ctl.Name & "'," & rs!Id & ",'" & ctl.Properties(3) & "');"
  99. DoCmd.RunSQL sqlInsert
  100. End If
  101. Next ctl
  102. DoCmd.Close
  103. rs.MoveNext
  104. Loop
  105. End Sub
  106.  
  107. Sub foo()
  108. With CurrentDb
  109. ' Durchlaufen der Containers-Auflistung.
  110. For Each ctrLoop In .Containers
  111. Debug.Print "Eigenschaften von" & ctrLoop.Name & " Container"
  112. ' Durchlaufen der Properties-Auflistung jedes
  113. ' Container-Objekts.
  114. For Each prpLoop In ctrLoop.Properties
  115. Debug.Print " " & prpLoop.Name & " = "; prpLoop
  116. Next prpLoop
  117.  
  118. For Each it In ctrLoop.Documents
  119. Debug.Print it.Name
  120. Next
  121. Next ctrLoop
  122. End With
  123. End Sub

Report this snippet  

You need to login to post a comment.