This code will get you started:
Public Function ListForms()
Dim ThisDB As DAO.Database
Dim varForm As DAO.Document
Dim strList As String
Set ThisDB = CurrentDb
For Each varForm In ThisDB.Containers("Forms").Documents
strList = strList & vbCrLf & varForm.Name
Next varForm
strList = Right$(strList, Len(strList) - 2)
ListForms = strList
End Function
Public Function ListTables()
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Set ThisDB = CurrentDb
Dim strList As String
For Each TDef In ThisDB.TableDefs
strList = strList & vbCrLf & TDef.Name
Next TDef
strList = Right$(strList, Len(strList) - 2)
ListTables = strList
End Function
Public Function ListFields(ByVal strTabName As String) As String
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim strList As String
Set ThisDB = CurrentDb
Set TDef = ThisDB.TableDefs(strTabName)
For Each MyField In TDef.Fields
strList = strList & vbCrLf & MyField.Name
Next MyField
ListFields = strList
End Function
Public Function CountTDefs() As Integer
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim intCount As Integer
Set ThisDB = CurrentDb
For Each TDef In ThisDB.TableDefs
intCount = intCount + 1
Next TDef
CountTDefs = intCount
End Function
Public Function FieldCount(ByVal strTabName As String) As Integer
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim intCount As Integer
Set ThisDB = CurrentDb
Set TDef = ThisDB.TableDefs(strTabName)
For Each MyField In TDef.Fields
intCount = intCount + 1
Next MyField
FieldCount = intCount
End Function
Public Function ListFieldTypes(ByVal strTabName As String) As String
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim strList As String
Set ThisDB = CurrentDb
Set TDef = ThisDB.TableDefs(strTabName)
For Each MyField In TDef.Fields
strList = strList & vbCrLf & DataTypeNumToText(MyField.Type)
Next MyField
ListFieldTypes = strList
End Function
Private Function DataTypeNumToText(ByVal intTypeNum As Integer) As String
Select Case intTypeNum
Case 1
DataTypeNumToText = "Boolean"
Case 2
DataTypeNumToText = "Byte"
Case 3
DataTypeNumToText = "Integer"
Case 4
DataTypeNumToText = "Long Integer"
Case 5
DataTypeNumToText = "Currency"
Case 7
DataTypeNumToText = "Double Precision"
Case 8
DataTypeNumToText = "Date"
Case 9
DataTypeNumToText = "Binary"
Case 10
DataTypeNumToText = "Text"
Case 12
DataTypeNumToText = "Memo"
Case 16
DataTypeNumToText = "Auto Number"
Case 19
DataTypeNumToText = "Numeric" '???why when each numeric data type has it's own number???
Case 20
DataTypeNumToText = "Decimal"
End Select
End Function
Public Function ListFieldLengths(ByVal strTabName As String) As String
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim strList As String
Set ThisDB = CurrentDb
Set TDef = ThisDB.TableDefs(strTabName)
For Each MyField In TDef.Fields
strList = strList & vbCrLf & MyField.Size
Next MyField
ListFieldLengths = strList
End Function
Public Function ListValRules(ByVal strTabName As String)
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim strList As String
Set ThisDB = CurrentDb
Set TDef = ThisDB.TableDefs(strTabName)
For Each MyField In TDef.Fields
strList = strList & vbCrLf & MyField.ValidationRule
Next MyField
ListValRules = strList
End Function
Public Function SQL_Search(strKeyWord) As String
Dim ThisDB As DAO.Database
Dim QDef As DAO.QueryDef
Dim strList As String
Set ThisDB = CurrentDb
For Each QDef In ThisDB.QueryDefs
If QDef.SQL Like "*" & strKeyWord & "*" Then
strList = strList & vbCrLf & QDef.Name
End If
Next QDef
SQL_Search = strList
End Function
Public Function CountMacros() As Integer
Dim ThisDB As DAO.Database
Dim docMac As Document
Dim Count As Integer
Set ThisDB = CurrentDb
For Each docMac In ThisDB.Containers("Scripts").Documents
Count = Count + 1
Next docMac
CountMacros = Count
End Function
Public Function CountQDefs()
Dim ThisDB As DAO.Database
Dim QDef As DAO.QueryDef
Dim Count As Integer
Set ThisDB = CurrentDb
For Each QDef In ThisDB.QueryDefs
Count = Count + 1
Next QDef
CountQDefs = Count
End Function
Public Function CountMods()
Dim ThisDB As DAO.Database
Dim docMod As DAO.Document
Dim Count As Integer
Set ThisDB = CurrentDb
For Each docMod In ThisDB.Containers("Modules").Documents
Count = Count + 1
Next docMod
CountMods = Count
End Function
Public Function ListFunctions() As Integer
Dim ThisDB As DAO.Database
Dim docMod As DAO.Document
Dim ModVB As Access.Module
Dim lngLineIndex As Long: lngLineIndex = 1
Dim strLine As String
Dim strList As String
Set ThisDB = CurrentDb
For Each docMod In ThisDB.Containers("Modules").Documents
Set ModVB = Application.Modules(docMod.Name)
Do While lngLineIndex <= ModVB.CountOfLines
strLine = ModVB.Lines(lngLineIndex, 1)
If strLine Like "Private Sub*" Or strLine Like "Public Sub*" Or strLine Like "Private Function*" Or strLine Like "Public Function*" Then
strList = strList & vbCrLf & strLine
End If
lngLineIndex = lngLineIndex + 1
Loop
Next docMod
ListFunctions = strList
End Function
Public Function ListMods() As String
Dim ThisDB As DAO.Database
Dim docMod As DAO.Document
Dim strList As String
Set ThisDB = CurrentDb
For Each docMod In ThisDB.Containers("Modules").Documents
strList = strList & vbCrLf & docMod.Name
Next docMod
ListMods = strList
End Function
Public Function ContainsField(ByVal strFieldName As String, Optional ByVal blnUseWildCards As Boolean = True) As String
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim strList As String
Set ThisDB = CurrentDb
For Each TDef In ThisDB.TableDefs
For Each MyField In TDef.Fields
If blnUseWildCards = True Then
If MyField.Name Like "*" & strFieldName & "*" Then
strList = strList & vbCrLf & TDef.Name
Exit For 'No need to carry on checking this table
End If
Else
If MyField.Name = strFieldName Then
strList = strList & vbCrLf & TDef.Name
Exit For 'No need to carry on checking this table
End If
End If
Next MyField
Next TDef
ContainsField = strList
End Function
Public Function CountTotalFields() As Integer
'Returns the total number of fields in the database
'Excludes system tables
'Written by Ed Metcalfe, 10/11/2002.
Dim Count As Integer
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
If Not tdf.Name Like "MSys*" Then
For Each fld In tdf.Fields
Count = Count + 1
Debug.Print tdf.Name & " = " & Count & " fields."
Next fld
End If
Next tdf
dbs.Close
Set fld = Nothing
Set tdf = Nothing
End Function
Public Function CountIndexes() As Long
'Returns the total number of indexes in the database
'Excludes system tables
'Written by Ed Metcalfe, 10/11/2002.
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim lngCount As Long
Set ThisDB = CurrentDb()
For Each TDef In ThisDB.TableDefs
If Not TDef.Name Like "MSys*" Then lngCount = lngCount + TDef.Indexes.Count
Next TDef
CountIndexes = lngCount
ThisDB.Close
Set TDef = Nothing
Set ThisDB = Nothing
End Function
Public Function ListAllTablesAndFields(Optional ByVal ExcludeMSysTables As Boolean = True) As String
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyField As DAO.Field
Dim retval As String
Set ThisDB = CurrentDb()
For Each TDef In ThisDB.TableDefs
If (Not TDef.Name Like "MSys*" And ExcludeMSysTables) Or (Not ExcludeMSysTables) Then
For Each MyField In TDef.Fields
retval = retval & TDef.Name & ", " & MyField.Name & ", " & MyField.Type & vbCrLf
Next MyField
End If
Next TDef
ListAllTablesAndFields = retval
ThisDB.Close
Set MyField = Nothing
Set TDef = Nothing
Set ThisDB = Nothing
End Function
Public Function ListAllIndexes(Optional ByVal ExcludeMSysTables As Boolean = True)
Dim ThisDB As DAO.Database
Dim TDef As DAO.TableDef
Dim MyIndex As DAO.Index
Dim retval As String
Set ThisDB = CurrentDb()
For Each TDef In ThisDB.TableDefs
If (Not TDef.Name Like "MSys*" And ExcludeMSysTables) Or (Not ExcludeMSysTables) Then
For Each MyIndex In TDef.Indexes
retval = retval & TDef.Name & "," & MyIndex.Name & "," & MyIndex.Fields & vbCrLf
Next MyIndex
End If
Next TDef
ListAllIndexes = retval
End Function
Ed Metcalfe.
Please do not feed the trolls.....
