Access Data Dictionary Erstellen

Attribute VB_Name = "DataDictionary"
Option Compare Database
'erstellt ein data dictionary aus einer access datenbank
 
Sub createDataDictionary()
On Error Resume Next
DoCmd.SetWarnings False
createDBSchema
strSql = "delete * from data_dictionary"
DoCmd.RunSQL strSql
 
For Each q In CurrentDb.QueryDefs
exportQuery q.Name
Next
 
For Each t In CurrentDb.TableDefs
exportTable t.Name
Next
 
exportReports
DoCmd.SetWarnings True
End Sub
 
Sub exportQuery(queryName As String)
Dim q As QueryDef
Dim f As Field
Set q = CurrentDb.QueryDefs(queryName)
queryName = q.Name
 
'die id der abfrage aus MSysObjects holen
strSql = "Select Id  from MSysObjects where Name='" & q.Name & "' AND type=5;"
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(strSql)
objectID = rs!Id
 
'fuer jedes feld der query
c = 0
For Each f In q.Fields
 
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 & "');"
DoCmd.RunSQL sqlInsert
c = c + 1
Next
 
'integration der Werte aus MSysQueries
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];"
DoCmd.RunSQL strSql
 
End Sub
 
 
Sub createDBSchema()
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))"
DoCmd.RunSQL sqlCreate
 
End Sub
 
 
'exportiert tabellen ins data dictionary
Sub exportTable(tableName As String)
Dim tblDef As TableDef
Dim f As Field
Set db = CurrentDb()
Set tblDef = db.TableDefs(tableName)
 
'die id der abfrage aus MSysObjects holen
strSql = "Select Id  from MSysObjects where Name='" & tblDef.Name & "' AND type=1;"
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(strSql)
objectID = rs!Id
 
'fuer jedes feld der tabelle
c = 0
For Each f In tblDef.Fields
 
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 & "');"
DoCmd.RunSQL sqlInsert
c = c + 1
Next
 
End Sub
 
Sub exportReports() 'Optional reportName As String
Dim rpt As Report, ctl As Control
Dim rs As Recordset
strSql = "Select id,Name from MSysObjects WHERE Type=-32764"
Set rs = CurrentDb.OpenRecordset(strSql)
On Error Resume Next
Do While Not rs.EOF
   DoCmd.OpenReport rs!Name, acViewPreview
    Set rpt = Reports(rs!Name)
    ' Name des Berichts ausgeben.
    Debug.Print rpt.Name
    ' Controls-Auflistung jedes Berichts durchlaufen.
    For Each ctl In rpt.Controls
        If ctl.ControlType = acTextBox Then
            Debug.Print ctl.Name & ": " & ctl.Properties(3)
            sqlInsert = "INSERT INTO data_dictionary ([type],[table_name],[field_name],[ObjectId],[expression]) VALUES ('report','" & rs!Name & "','" & ctl.Name & "'," & rs!Id & ",'" & ctl.Properties(3) & "');"
            DoCmd.RunSQL sqlInsert
        End If
    Next ctl
DoCmd.Close
rs.MoveNext
Loop
End Sub
 
Sub foo()
With CurrentDb
        ' Durchlaufen der Containers-Auflistung.
        For Each ctrLoop In .Containers
            Debug.Print "Eigenschaften von" & ctrLoop.Name & " Container"
            ' Durchlaufen der Properties-Auflistung jedes
            ' Container-Objekts.
            For Each prpLoop In ctrLoop.Properties
                Debug.Print "    " & prpLoop.Name & " = "; prpLoop
            Next prpLoop
 
            For Each it In ctrLoop.Documents
                Debug.Print it.Name
            Next
        Next ctrLoop
    End With
End Sub