How to list or print all the Command text property for all queries and connections in Excel sheet

[eweline]

Hello,

I have 40+ Queries and Connections in an Excel sheet. There is an older version of this report and I'm trying to analyze if the 'Command Text' is still the same or not.

Can you please let me know what is the VB script to print all the "Command Text" properties?

Thanks

 

[John_w]

Try this macro, which can be edited to operate on either the macro workbook or the active workbook:

    'Either operate on this macro workbook
    'Set wb = ThisWorkbook
    'Or operate on the active workbook
    Set wb = ActiveWorkbook

Private Sub List_Command_Text()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim listObj As ListObject
    Dim qt As QueryTable
    Dim qtName As String
    Dim n As Long
    Dim wbConn As WorkbookConnection
    Dim qcSheet As Worksheet, r As Long
    
    'Either operate on this macro workbook
    'Set wb = ThisWorkbook
    'Or operate on the active workbook
    Set wb = ActiveWorkbook
    
    Set qcSheet = GetWbSheet(wb, "Queries Conns")
    If qcSheet Is Nothing Then
        With wb
            Set qcSheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            qcSheet.Name = "Queries Conns"
        End With
    End If
    
    qcSheet.Cells.Clear
    r = 1
    qcSheet.Cells(r, "A").Value = "QueryTables"
    qcSheet.Cells(r, "A").Font.Bold = True
    r = r + 1
    qcSheet.Cells(r, "A").Resize(, 3).Value = Array("Worksheet", "QueryTable Name", "QueryTable CommandText")
    r = r + 1
    
    For Each ws In wb.Worksheets
        If Not ws Is qcSheet Then
            qcSheet.Cells(r, "A").Value = ws.Name
            n = 0
            For Each qt In ws.QueryTables
                qcSheet.Cells(r + n, "B").Value = qt.Name
                qcSheet.Cells(r + n, "C").Value = qt.CommandText
                n = n + 1
            Next
            If n = 0 Then n = 1
            r = r + n
        End If
    Next
    
    r = r + 1
    qcSheet.Cells(r, "A").Value = "ListObjects"
    qcSheet.Cells(r, "A").Font.Bold = True
    r = r + 1
    qcSheet.Cells(r, "A").Resize(, 4).Value = Array("Worksheet", "Name", "QueryTable Name", "QueryTable CommandText")
    r = r + 1
    
    For Each ws In wb.Worksheets
        If Not ws Is qcSheet Then
            n = 0
            For Each listObj In ws.ListObjects
                qcSheet.Cells(r + n, "A").Value = ws.Name
                qcSheet.Cells(r + n, "B").Value = listObj.Name
                Set qt = Nothing
                On Error Resume Next
                Set qt = listObj.QueryTable
                On Error GoTo 0
                If Not qt Is Nothing Then
                    qtName = "Undefined"
                    On Error Resume Next
                    qtName = qt.Name
                    On Error GoTo 0
                    qcSheet.Cells(r + n, "C").Value = qtName
                    qcSheet.Cells(r + n, "D").Value = qt.CommandText
                End If
                n = n + 1
            Next
            r = r + n
        End If
        
    Next
    
    r = r + 1
    qcSheet.Cells(r, "A").Value = "Workbook Connections"
    qcSheet.Cells(r, "A").Font.Bold = True
    r = r + 1
    qcSheet.Cells(r, "A").Resize(, 2).Value = Array("Name", "CommandText")
    r = r + 1
    
    n = 0
    For Each wbConn In wb.Connections
        qcSheet.Cells(r + n, "A").Value = wbConn.Name
        Select Case wbConn.Type
            Case Is = xlConnectionTypeODBC
                qcSheet.Cells(r + n, "B").Value = wbConn.ODBCConnection.CommandText
            Case Is = xlConnectionTypeOLEDB
                qcSheet.Cells(r + n, "B").Value = wbConn.OLEDBConnection.CommandText
        End Select
        n = n + 1
    Next

End Sub


Private Function GetWbSheet(wb As Workbook, sheetName As String) As Worksheet
    Set GetWbSheet = Nothing
    On Error Resume Next
    Set GetWbSheet = wb.Worksheets(sheetName)
    On Error Resume Next
End Function