List Table Fields

The ListTableFields function (called from the USysRegInfo table) lists the fields in all the tables in the database, using the TableDefs collection of the DAO object model:

Public Function ListTableFields() 'Called from USysRegInfo

On Error Resume Next

Call CopyListObjects Set dbsCode = CodeDb Set dbsCalling = CurrentDb

Delete the old table in code database (if there is one):

strTable = "zstblTableAndFieldNames" Set tdfsCode = dbsCode.TableDefs Set tdfCode = tdfsCode(strTable) If Not tdfCode Is Nothing Then tdfsCode.Delete (strTable) End If

Delete the old table in the calling database (if there is one):

Set tdfsCalling = dbsCalling.TableDefs Set tdfCalling = tdfsCalling(strTable) If Not tdfCalling Is Nothing Then tdfsCalling.Delete (strTable) End If

Create a new, blank table in the code database to fill with data:

DoCmd.CopyObject destinationdatabase:=strCodeDB, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable & "Blank"

Fill the table in the code database with table and field names from the calling database:

Set rst = dbsCode.OpenRecordset(strTable, dbOpenTable) strExcludeTable = "zstblTablePrefixes"

For Each tdfCalling In dbsCalling.TableDefs strTable = tdfCalling.Name

If ExcludePrefix(strTable, strExcludeTable) = _ False Then

Set flds = tdfCalling.Fields For Each fld In flds strFieldName = fld.Name With rst .AddNew

!TableName = strTable !FieldName = strFieldName !DataType = fld.Type

!ValidationRule = fld.ValidationRule !Required = fld.Required .Update End With Next fld End If Next tdfCalling rst.Close

Copy the filled table to the calling database so it will be available for printing in the calling database:

strTable = "zstblTableAndFieldNames" Set tdfCode = dbsCode.TableDefs(strTable) DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable

DoCmd.OpenTable strTable strTitle = "Table filled" strPrompt = "Print report now?"

intReturn = MsgBox(strPrompt, vbQuestion + vbYesNo, _

strTitle) If intReturn = vbYes Then strReport = "zsrptTableAndFieldNames" DoCmd.OpenReport strReport End If

ErrorHandlerExit: Exit Function

ErrorHandler:

& "; Description: " & err.Description Resume ErrorHandlerExit

End Function

0 0

Post a comment