'************************ Class Code Start ****************************************************
Public Function fncDocumentTables() As String
Dim strDocument As String
Dim tblDef As DAO.TableDef
Dim fld As DAO.Field
Dim strSql As String
For Each tblDef In CurrentDb.TableDefs
If Not Left(tblDef.Name, 4) = "MSys" Then
strDocument = strDocument & vbCrLf & tblDef.Name & vbCrLf
For Each fld In tblDef.Fields
strDocument = strDocument & " " & fld.Name & " " & fncFldTypeToString(fld.Type)
If isPK(tblDef, fld.Name) Then
strDocument = strDocument & " PrimaryKey"
End If
If isFK(tblDef, fld.Name) Then
strDocument = strDocument & " ForiegnKey"
End If
If isIndex(tblDef, fld.Name) Then
strDocument = strDocument & " Indexed"
End If
If fld.required Then
strDocument = strDocument & " Required"
End If
strDocument = strDocument & vbCrLf
Next fld
End If
Next tblDef
fncDocumentTables = strDocument
End Function
Public Function WriteTables() As String
Dim strDocument As String
Dim tblDef As DAO.TableDef
Dim fld As DAO.Field
Dim strSql As String
Dim tableName As String
Dim fieldName As String
Dim strDataType As String
Dim keyType As String
Dim strIndexed As String
Dim strRequired As String
strSql = "INSERT INTO tblTables (TableName,FieldName,DataType,KeyType,Indexed, Required) Values ("
For Each tblDef In CurrentDb.TableDefs
If Not Left(tblDef.Name, 4) = "MSys" Then
strDocument = strDocument & vbCrLf & tblDef.Name & vbCrLf
For Each fld In tblDef.Fields
strDocument = strDocument & " " & fld.Name & " " & fncFldTypeToString(fld.Type)
If isPK(tblDef, fld.Name) Then
strDocument = strDocument & " PrimaryKey"
End If
If isFK(tblDef, fld.Name) Then
strDocument = strDocument & " ForiegnKey"
End If
If isIndex(tblDef, fld.Name) Then
strDocument = strDocument & " Indexed"
End If
If fld.required Then
strDocument = strDocument & " Required"
End If
strDocument = strDocument & vbCrLf
Next fld
End If
Next tblDef
fncDocumentTables = strDocument
End Function
Public Function fncFldTypeToString(intFieldType As Integer) As String
Select Case intFieldType
Case 1
fncFldTypeToString = "dbBoolean"
Case 2
fncFldTypeToString = "dbByte"
Case 3
fncFldTypeToString = "dbInteger"
Case 4
fncFldTypeToString = "dbLong"
Case 5
fncFldTypeToString = "dbCurrency"
Case 6
fncFldTypeToString = "dbSingle"
Case 7
fncFldTypeToString = "dbDouble"
Case 8
fncFldTypeToString = "dbDate"
Case 9
fncFldTypeToString = "dbBinary"
Case 10
fncFldTypeToString = "dbText"
Case 11
fncFldTypeToString = "dbLongBinary"
Case 12
fncFldTypeToString = "dbMemo"
Case 13
fncFldTypeToString = "Text"
Case 14
fncFldTypeToString = "Text"
Case 15
fncFldTypeToString = "dbGUID"
Case 16
fncFldTypeToString = "dbBigInt"
Case 17
fncFldTypeToString = "dbVarBinary"
Case 18
fncFldTypeToString = "dbChar"
Case 19
fncFldTypeToString = "dbNumeric"
Case 20
fncFldTypeToString = "dbDecimal"
Case 21
fncFldTypeToString = "dbFloat"
Case 22
fncFldTypeToString = "dbTime"
Case 23
fncFldTypeToString = "dbTimeStamp"
End Select
End Function
Public Function isPK(tblDef As DAO.TableDef, strField As String) As Boolean
Dim idx As DAO.Index
Dim fld As DAO.Field
For Each idx In tblDef.Indexes
If idx.Primary Then
For Each fld In idx.Fields
If strField = fld.Name Then
isPK = True
Exit Function
End If
Next fld
End If
Next idx
End Function
Public Function isIndex(tblDef As DAO.TableDef, strField As String) As Boolean
Dim idx As DAO.Index
Dim fld As DAO.Field
For Each idx In tblDef.Indexes
For Each fld In idx.Fields
If strField = fld.Name Then
isIndex = True
Exit Function
End If
Next fld
Next idx
End Function
Public Function isFK(tblDef As DAO.TableDef, strField As String) As Boolean
Dim idx As DAO.Index
Dim fld As DAO.Field
For Each idx In tblDef.Indexes
If idx.Foreign Then
For Each fld In idx.Fields
If strField = fld.Name Then
isFK = True
Exit Function
End If
Next fld
End If
Next idx
End Function
Public Function fncDocumentRelations() As String
Dim strDocument As String
Dim rel As DAO.Relation
Dim fld As DAO.Field
Dim idx As DAO.Index
Dim prop As DAO.Property
For Each rel In CurrentDb.relations
strDocument = strDocument & vbCrLf & "Name: " & rel.Name & vbCrLf
strDocument = strDocument & " " & "Table: " & rel.Table & vbCrLf
strDocument = strDocument & " " & "Foreign Table: " & rel.ForeignTable & vbCrLf
For Each fld In rel.Fields
strDocument = strDocument & " PK: " & fld.Name & " FK:" & fld.ForeignName
strDocument = strDocument & vbCrLf
Next fld
Next rel
fncDocumentRelations = strDocument
End Function
Public Function fncDocumentQueries() As String
Dim strDocument As String
Dim qryDef As DAO.QueryDef
Dim fld As DAO.Field
Dim idx As DAO.Index
For Each qryDef In CurrentDb.QueryDefs
If Not (Left(qryDef.Name, 4) = "MSys" Or Left(qryDef.Name, 4) = "~sq_") Then
strDocument = strDocument & vbCrLf & qryDef.Name & vbCrLf
For Each fld In qryDef.Fields
strDocument = strDocument & " " & fld.Name & " " & fncFldTypeToString(fld.Type)
strDocument = strDocument & vbCrLf
Next fld
strDocument = strDocument & qryDef.SQL & vbCrLf
End If
Next qryDef
fncDocumentQueries = strDocument
End Function
Public Sub DocumentTables()
Debug.Print fncDocumentTables
End Sub
Public Sub DocumentRelations()
Debug.Print fncDocumentRelations
End Sub
Public Sub DocumentQueries()
Debug.Print fncDocumentQueries
End Sub
