List all objects 2

[scottian]

Before anyone starts, I have searched for this and i do know its here somewhere. Im trying to find the code that lists all the objects in a database but i cant find it. Does anyone have it please.

"Children are smarter than any of us. Know how I know that? I don't know one child with a full time job and children."...Bill Hicks

 

[Remou]

You can build one or use the one on this site:

http://www.jrbarnett.freeserve.co.uk/

 

[scottian]

Thanks Remou, but due to security measures, im not allowed to download from the net.

"Children are smarter than any of us. Know how I know that? I don't know one child with a full time job and children."...Bill Hicks

 

[Ed2020]

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.....

 

[scottian]

Thanks Ed2020

"Children are smarter than any of us. Know how I know that? I don't know one child with a full time job and children."...Bill Hicks

 

[MichaelRed]

for a much shorter process, look into MSysObjects (hidden system table)

Although the above set of procedures would tend to provide some information not directly available from the table. Then, again, for his approach to be effective you would need to run the set of procedures mostly independently (they offer the same return value which then needs to be examined, saved concatenated ... ).



MichaelRed