Results 1 to 4 of 4
  1. #1
    Join Date
    Feb 2006
    Posts
    26

    Unanswered: Missing db objects and object types in output

    Hi All,

    I have this script which works but for my life I cannot figure out three things:

    A: why the does the output only has Select Queries and Union Queries and ignores all Make Table and append queries
    B: Once (A) work, I would like to add the type of the query name in the output as a column
    C: How can I bring the ObjectID from Msysobject as a output column

    Thanks in advance, any help is very appreciated.

    PHP Code:
    Sub ListQueriesAndFields()

        
    Dim lTbl As Long
        Dim lFld 
    As Long
        Dim dBase 
    As Database
        Dim xlApp 
    As Object
        Dim wbExcel 
    As Object
        Dim lRow 
    As Long
         
         
    'Set current database to a variable adn create a new Excel instance
        Set dBase = CurrentDb
        Set xlApp = CreateObject("Excel.Application")
        Set wbExcel = xlApp.workbooks.Add
         
         '
    Set on error in case there are no tables
        On Error Resume Next
         
        lRow 
    1
        With wbExcel
    .sheets(1)
            .
    Range("A" lRow) = "DBName"
            
    .Range("B" lRow) = "DBVersion"
            
    .Range("C" lRow) = "Query Name"
            
    .Range("D" lRow) = "Query Field Name"
            
    .Range("E" lRow) = "Type"
            
    .Range("F" lRow) = "Size"
            
    .Range("G" lRow) = "Source Table"
            
    .Range("H" lRow) = "Source Field"
        
    End With
        
         
    'Loop through all tables
        For lTbl = 0 To dBase.QueryDefs.Count
             '
    If the table name is a temporary or system table then ignore it
            
    If Left(dBase.QueryDefs(lTbl).Name1) = "~" Or _
            Left
    (dBase.QueryDefs(lTbl).Name4) = "MSYS" Then
                 
    '~ indicates a temporary table
                 '
    MSYS indicates a system level table
            
    Else
                 
    'Otherwise, loop through each table, writing the table and field names
                 '
    to the Excel file
                
    For lFld 0 To dBase.QueryDefs(lTbl).Fields.Count 1  'DJK 2011/01/27 - Changed initial base from 1 to 0, and added type, size, and description
                    lRow = lRow + 1
                    With wbExcel.sheets(1)
                        .Range("A" & lRow) = CurrentProject.Name
                        .Range("B" & lRow) = dBase.Version
                        .Range("C" & lRow) = dBase.QueryDefs(lTbl).Name
                        .Range("D" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Name
                        .Range("E" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Type
                        .Range("F" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Size
                        .Range("G" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).SourceTable
                        .Range("H" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).SourceField
                    End With
                Next lFld
            End If
        Next lTbl
         '
    Resume error breaks
        On Error 
    GoTo 0
         
         
    'Set Excel to visible and release it from memory
        xlApp.Visible = True
        Set xlApp = Nothing
        Set wbExcel = Nothing
         
         '
    Release database object from memory
        Set dBase 
    Nothing
         
    End Sub 

  2. #2
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    In your procedure, you write into the Excel sheet only when the Fields collection of the QueryDef is not empty:
    Code:
    For lFld = 0 To dBase.QueryDefs(lTbl).Fields.Count - 1
    QueryDefs other than those storing a SELECT query don't have Fields (i.e. the Fields collection is empty), so nothing is written in Excel.

    If you want to mess with the MSysObjects table (not a very good idea but that's your choice), you can as well retrieve the names of the queries from it. Here's a solution:
    Code:
    Sub ListQueriesAndFields()
    
        Dim lTbl As Long
        Dim lFld As Long
        Dim dBase As Database
        Dim xlApp As Object
        Dim wbExcel As Object
        Dim lRow As Long
          
         'Set current database to a variable adn create a new Excel instance
        Set dBase = CurrentDb
        Set xlApp = CreateObject("Excel.Application")
        Set wbExcel = xlApp.Workbooks.Add
          
         'Set on error in case there are no tables
        On Error Resume Next
          
        lRow = 1
        With wbExcel.Sheets(1)
            .Range("A" & lRow) = "DBName"
            .Range("B" & lRow) = "DBVersion"
            .Range("C" & lRow) = "Query Name"
            .Range("D" & lRow) = "Query Field Name"
            .Range("E" & lRow) = "Type"
            .Range("F" & lRow) = "Size"
            .Range("G" & lRow) = "Source Table"
            .Range("H" & lRow) = "Source Field"
            .Range("I" & lRow) = "Query Type"
            .Range("J" & lRow) = "ObjectID"
        End With
        
        Const c_SQL As String = "select [name], Id FROM MSysObjects WHERE [type] = 5 ORDER BY [name];"
        Dim rst As DAO.Recordset
        Dim qdf As DAO.QueryDef
        Dim strQueryType As String
        
        Set rst = dBase.OpenRecordset(c_SQL, dbOpenSnapshot)
        With rst
            Do Until .EOF
            If Left(!Name, 1) <> "~" And Left(!Name, 4) <> "MSYS" Then
                    Set qdf = dBase.QueryDefs(!Name)
                    Select Case qdf.Type
                        Case dbQAction:         strQueryType = "Action query"
                        Case dbQAppend:         strQueryType = "Append query"
                        Case dbQCrosstab:       strQueryType = "Crosstab query"
                        Case dbQDDL:            strQueryType = "DDL query"
                        Case dbQDelete:         strQueryType = "Delete query"
                        Case dbQMakeTable:      strQueryType = "Make Table query"
                        Case dbQSelect:         strQueryType = "Select query"
                        Case dbQSetOperation:   strQueryType = "Union query"
                        Case dbQSQLPassThrough: strQueryType = "SQL Pass Through query"
                        Case dbQUpdate:         strQueryType = "Update query"
                        Case Else:              strQueryType = "Unknown query type"
                    End Select
                    With wbExcel.Sheets(1)
                        If qdf.Fields.Count = 0 Then
                            lRow = lRow + 1
                            .Range("A" & lRow) = CurrentProject.Name
                            .Range("B" & lRow) = dBase.Version
                            .Range("C" & lRow) = qdf.Name
                            .Range("I" & lRow) = strQueryType
                            .Range("J" & lRow) = rst!ID
                        Else
                            For lFld = 0 To qdf.Fields.Count - 1
                                lRow = lRow + 1
                                .Range("A" & lRow) = CurrentProject.Name
                                .Range("B" & lRow) = dBase.Version
                                .Range("C" & lRow) = qdf.Name
                                .Range("D" & lRow) = qdf.Fields(lFld).Name
                                .Range("E" & lRow) = qdf.Fields(lFld).Type
                                .Range("F" & lRow) = qdf.Fields(lFld).Size
                                .Range("G" & lRow) = qdf.Fields(lFld).SourceTable
                                .Range("H" & lRow) = qdf.Fields(lFld).SourceField
                                .Range("I" & lRow) = strQueryType
                                .Range("J" & lRow) = rst!ID
                            Next lFld
                        End If
                    End With
                End If
                .MoveNext
            Loop
            .Close
        End With
          
    '     'Loop through all tables
    '    For lTbl = 0 To dBase.QueryDefs.Count
    '         'If the table name is a temporary or system table then ignore it
    '        If Left(dBase.QueryDefs(lTbl).Name, 1) = "~" Or _
    '        Left(dBase.QueryDefs(lTbl).Name, 4) = "MSYS" Then
    '             '~ indicates a temporary table
    '             'MSYS indicates a system level table
    '        Else
    '             'Otherwise, loop through each table, writing the table and field names
    '             'to the Excel file
    '            For lFld = 0 To dBase.QueryDefs(lTbl).Fields.Count - 1  'DJK 2011/01/27 - Changed initial base from 1 to 0, and added type, size, and description
    '                lRow = lRow + 1
    '                With wbExcel.Sheets(1)
    '                    .Range("A" & lRow) = CurrentProject.Name
    '                    .Range("B" & lRow) = dBase.Version
    '                    .Range("C" & lRow) = dBase.QueryDefs(lTbl).Name
    '                    .Range("D" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Name
    '                    .Range("E" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Type
    '                    .Range("F" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).Size
    '                    .Range("G" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).SourceTable
    '                    .Range("H" & lRow) = dBase.QueryDefs(lTbl).Fields(lFld).SourceField
    '                End With
    '            Next lFld
    '        End If
    '    Next lTbl
         'Resume error breaks
        On Error GoTo 0
          
         'Set Excel to visible and release it from memory
        xlApp.Visible = True
        Set xlApp = Nothing
        Set wbExcel = Nothing
          
         'Release database object from memory
        Set dBase = Nothing
          
    End Sub
    Have a nice day!

  3. #3
    Join Date
    Feb 2006
    Posts
    26

    Missing db objects and object types in output

    Thank you very much sir, although I spotted the field =0 after my post I wouldn't have figured bringing the msysobjects in the same routine.

    Quick question, is there anyway of populating the same fields for MakeTable queries and others as it does for Select Queries?

    Also is there a routine that would export out the object dependencies against table and all type of queries? I can see it in the UI but there are hundreds of tables that we need go through manually.


    Thanks again for you help.

  4. #4
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    Quote Originally Posted by riqband View Post
    Quick question, is there anyway of populating the same fields for MakeTable queries and others as it does for Select Queries?
    Not as far as I know because these types of queries do not have a Fields collection (more exactly: their Fields collection is empty). You could write a SQL parser to analyze the SQL property of these queries and extract the information you need, but it's quite a lot of work.
    Quote Originally Posted by riqband View Post
    Also is there a routine that would export out the object dependencies against table and all type of queries? I can see it in the UI but there are hundreds of tables that we need go through manually.
    More or less. Here's a path to a possible solution:
    Code:
    Sub ListDependencies()
    
        Dim obj As AccessObject
        Dim dbs As Object
        Dim dcy As DependencyInfo
        Dim i As Long
        Dim x As Variant
     
    '
    ' "Track Name AutoCorrect Info" must be on to use the GetDependencyInfo method.
    '   
        x = Application.GetOption("Track Name AutoCorrect Info")
        Application.SetOption "Track Name AutoCorrect Info", 1
        Set dbs = Application.CurrentData
        For Each obj In dbs.AllTables
            If obj.Name Like "MSys*" = False Then
                Set dcy = obj.GetDependencyInfo
                If dcy.Dependants.Count > 0 Then
                    For i = 0 To dcy.Dependants.Count - 1
                        Debug.Print obj.Name, dcy.Dependants(i).FullName
                    Next i
                End If
            End If
        Next obj
        For Each obj In dbs.AllQueries
            If (obj.Name Like "MSys*" = False) And (Left(Obj.Name, 1) <> "~") Then
                Set dcy = obj.GetDependencyInfo
                If dcy.Dependants.Count > 0 Then
                    For i = 0 To dcy.Dependants.Count - 1
                        Debug.Print obj.Name, dcy.Dependants(i).FullName
                    Next i
                End If
            End If
        Next obj
        Application.SetOption "Track Name AutoCorrect Info", x
        
    End Sub
    Quote Originally Posted by riqband View Post
    Thanks again for you help.
    You're welcome!
    Have a nice day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •