List Query Fields

The ListQueryFields function (called from the USysRegInfo table) lists the fields in all the select queries in the database, using the QueryDefs collection of the DAO object model:

Public Function ListQueryFields()

'Called from USysRegInfo

On Error Resume Next Call CopyListObjects

Set dbsCode = CodeDb

Set dbsCalling = CurrentDb

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

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

Delete old table in 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 = "zstblQueryPrefixes"

For Each qdf In dbsCalling.QueryDefs strQuery = qdf.Name

Debug.Print "Query name: " & strQuery If ExcludePrefix(strQuery, strExcludeTable) = _ False Then

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

!QueryName = strQuery !FieldName = strFieldName !DataType = fld.Type !Required = fld.Required .Update End With Next fld End If

Next qdf rst.Close

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

strTable = "zstblQueryAndFieldNames" 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 = "zsrptQueryAndFieldNames" DoCmd.OpenReport strReport End If

ErrorHandlerExit: Exit Function

ErrorHandler:

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

End Function

0 0

Post a comment