A much more elaborate procedure that gives more information and has a lot of
error handling, etc is the procedure below "QueriesList" which is the main
procedure you would call.  I don't believe there is any 'wrapping' of code
lines but keep there may be.

'MACRO STARTS HERE
'/============================================/
Option Explicit

'Public iDriveType As Integer
Public strNetwork As String

'/============================================/
Sub QueriesList()
On Error Resume Next
'Purpose of this VBA program is to find and list all Queries
'in a Workbook
'       For use with EXCEL 97 or higher
'  written by Gary L. Brown
'
  Dim iRow As Long, iColumn As Long, dblLastRow
  Dim i As Integer
  Dim x As Integer, iWorksheets As Integer
  Dim objOutputArea As Object
  Dim qryTable As QueryTable
  Dim strQueryParameters As String
  Dim strRngAddress As String
  Dim strResultsTableName As String
  Dim strOrigCalcStatus As String
  Dim wksWorksheet As Worksheet

  '/- - Initialize various Variables - -/
  strResultsTableName = "Queries_Table"
  strQueryParameters = ""
  strRngAddress = ""
  x = 0
  '/- - - - - - - - - - - - - - - - - -/
 
  'save calculation setting
  Select Case Application.Calculation
    Case xlCalculationAutomatic
      strOrigCalcStatus = "Automatic"
    Case xlCalculationManual
      strOrigCalcStatus = "Manual"
    Case xlCalculationSemiautomatic
      strOrigCalcStatus = "SemiAutomatic"
    Case Else
      strOrigCalcStatus = "Automatic"
  End Select
 
  'set workbook to manual
  Application.Calculation = xlManual

  'check to see if there are any MS Queries in active workbook
  For Each wksWorksheet In ActiveWorkbook.Worksheets
    For Each qryTable In wksWorksheet.QueryTables
      If wksWorksheet.QueryTables.Count > 0 Then
        x = 1
        Exit For
      End If
    Next qryTable
    If x = 1 Then
      Exit For
    End If
  Next wksWorksheet

  If x = 1 Then 'proceed if there are active MS Queries in Wkbk
    'Check for duplicate Worksheet name
    i = ActiveWorkbook.Sheets.Count
    For x = 1 To i
    If Windows.Count = 0 Then Exit Sub
      If UCase(Worksheets(x).name) = _
       UCase(strResultsTableName) Then
        Worksheets(x).Activate
        If Err.Number = 9 Then
              Exit For
        End If
        Application.DisplayAlerts = False
        ActiveWindow.SelectedSheets.Delete
        Application.DisplayAlerts = True
        'Exit Sub
      End If
    Next

    'Add new worksheet at end of workbook
    '   where results will be located
    Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
   
    'Name the new worksheet and set up Titles
    ActiveWorkbook.ActiveSheet.name = strResultsTableName
    ActiveWorkbook.ActiveSheet.Range("A1").value = _
     "Worksheet/Range"
    ActiveWorkbook.ActiveSheet.Range("B1").value = "Query Name"
    ActiveWorkbook.ActiveSheet.Range("C1").value = "Connection"
    ActiveWorkbook.ActiveSheet.Range("D1").value = "Parameters"
    ActiveWorkbook.ActiveSheet.Range("E1").value = "SQL"
 
    'Count number of worksheets in workbook
    iWorksheets = ActiveWorkbook.Sheets.Count
   
    'Initialize row and column counts for putting info into
    '        strResultsTableName sheet
    iRow = 1
    iColumn = 0
   
    Set objOutputArea = _
     ActiveWorkbook.Sheets(strResultsTableName).Range("A1")
   
   'evaluate all queries in the workbook
    If Windows.Count = 0 Then
      Exit Sub
    End If
    For Each wksWorksheet In ActiveWorkbook.Worksheets
      For Each qryTable In wksWorksheet.QueryTables
        With objOutputArea
          'put information into strResultsTableName worksheet
          strRngAddress = _
           FindQueryRange(qryTable.name, wksWorksheet.name)
          If Len(strRngAddress) > 0 Then
            'Syntax is different for local vs. network drives
            If strNetwork = "LOCAL" Then
              .Hyperlinks.Add Anchor:=.Offset(iRow, iColumn), _
                Address:="", _
                SubAddress:=wksWorksheet.name & "!" & _
                ChangeQueryNameToRangeName(qryTable.name), _
                TextToDisplay:=Chr(39) & " " & _
                Right(strRngAddress, Len(strRngAddress) - 1)
             Else
              .Hyperlinks.Add Anchor:=.Offset(iRow, iColumn), _
                Address:="", SubAddress:=Chr(39) & _
                wksWorksheet.name & Chr(39) & "!" & _
                ChangeQueryNameToRangeName(qryTable.name), _
                TextToDisplay:=Chr(39) & " " & _
                Right(strRngAddress, Len(strRngAddress) - 1)
            End If
          End If
          .Offset(iRow, iColumn + 1) = " " & qryTable.name
          .Offset(iRow, iColumn + 2) = qryTable.Connection
          strQueryParameters = "# of Parameters: " & _
           qryTable.Parameters.Count
          If qryTable.Parameters.Count > 0 Then
            strQueryParameters = strQueryParameters & vbLf & _
             "  Parameters: "
            For x = 1 To qryTable.Parameters.Count
              strQueryParameters = _
               strQueryParameters & vbLf & "   -   " & _
                qryTable.Parameters(x).PromptString
            Next x
          End If
          .Offset(iRow, iColumn + 3) = " " & strQueryParameters
          .Offset(iRow, iColumn + 4) = qryTable.Sql
          iRow = iRow + 1
        End With
      Next qryTable
    Next wksWorksheet
       
    'Release all variables from memory
    Set objOutputArea = Nothing
 
    'formatting output
    Columns("A:E").Select
    With Selection
      .WrapText = False
    End With
   
    Columns("A:E").EntireColumn.AutoFit
   
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = True
    End With
    With Selection.Font
        .Underline = xlUnderlineStyleSingleAccounting
    End With
    Range("A2").Select
    ActiveWindow.FreezePanes = True
   
    Columns("A:A").Select
    If Selection.ColumnWidth > 50 Then
        Selection.ColumnWidth = 50
    End If
    With Selection
        .WrapText = True
    End With
   
    Columns("B:B").Select
    If Selection.ColumnWidth > 50 Then
        Selection.ColumnWidth = 50
    End If
    With Selection
        .WrapText = True
    End With
   
    Columns("C:C").Select
    If Selection.ColumnWidth > 50 Then
        Selection.ColumnWidth = 50
    End If
    With Selection
        .WrapText = True
        .EntireColumn.AutoFit
    End With
   
    Columns("D:D").Select
    If Selection.ColumnWidth > 50 Then
        Selection.ColumnWidth = 50
    End If
    With Selection
        .WrapText = True
        .EntireColumn.AutoFit
    End With
   
    Columns("E:E").Select
    If Selection.ColumnWidth > 75 Then
        Selection.ColumnWidth = 75
    End If
    With Selection
        .WrapText = True
    End With
   
    Cells.Select
    With Selection
        .EntireRow.AutoFit
        .VerticalAlignment = xlTop
    End With
 
    Range("A1").Select
   
    'formatting printing
    With ActiveSheet.PageSetup
      .PrintTitleRows = "$1:$1"
    End With
    With ActiveSheet.PageSetup
      .LeftMargin = Application.InchesToPoints(0.75)
      .RightMargin = Application.InchesToPoints(0.25)
      .TopMargin = Application.InchesToPoints(0.5)
      .BottomMargin = Application.InchesToPoints(0.5)
      .HeaderMargin = Application.InchesToPoints(0.25)
      .FooterMargin = Application.InchesToPoints(0.25)
      .Orientation = xlLandscape
      .Order = xlOverThenDown
      .Zoom = 80
      .LeftHeader = "&""Tms Rmn,Bold""&U&A"
      .LeftFooter = "Printed: &D - &T"
      .CenterFooter = "Page &P of &N"
      .RightFooter = "&F-&A"
      .PrintGridlines = True
      .FitToPagesWide = 1
      .FitToPagesTall = False
    End With
   
    ActiveWindow.Zoom = 75
   Else
    MsgBox "There are no MS Queries in this Workbook." & _
     vbCr & vbCr & "Query Listing ended.", _
     vbInformation + vbOKOnly, "No MS Queries found..."
  End If
 
  're-set to original calculation method
  Select Case strOrigCalcStatus
    Case "Automatic"
      Application.Calculation = xlCalculationAutomatic
    Case "Manual"
      Application.Calculation = xlCalculationManual
    Case "SemiAutomatic"
      Application.Calculation = xlCalculationSemiautomatic
    Case Else
      Application.Calculation = xlCalculationAutomatic
  End Select

Application.Dialogs(xlDialogWorkbookName).Show

End Sub
'/============================================/
Private Function FindQueryRange(strQueryName As String, _
 strWorksheetName As String) As String
 Dim nRangeName As name
 Dim strRangeAddress As String
 Dim strRangeName As String
 
 'initialize
 FindQueryRange = ""
 strNetwork = ""
 strRangeAddress = ""
 strRangeName = ""
 
 
 'step 1 is to make the Query name correspond to the
 '  range name because query names can use all sorts
 '  of special characters while range names can only
 '  use a limited range of characters.
 '  The rest of the special characters are translated to an
 '  underscore "_".
 '
 strRangeName = ChangeQueryNameToRangeName(strQueryName)
   
 'step 2 is to find the range name to get the range address
 '    -  single quotation (')/Chr(39) syntax is used
 '                             for network addresses
 strRangeName = Chr(39) & strWorksheetName & Chr(39) & "!" & _
   strRangeName
 
 
 'check for network address - if local string will be empty
 For Each nRangeName In ActiveWorkbook.Names
   If nRangeName.name = strRangeName Then
     strRangeAddress = nRangeName.RefersTo
     Exit For
   End If
 Next nRangeName
 
 'if the string came back empty
 '  then the address is from a local drive
 If Len(strRangeAddress) = 0 Then
   strRangeName = ChangeQueryNameToRangeName(strQueryName)
   strRangeName = strWorksheetName & "!" & strRangeName
   For Each nRangeName In ActiveWorkbook.Names
     If nRangeName.name = strRangeName Then
       strRangeAddress = nRangeName.RefersTo
       Exit For
     End If
   Next nRangeName
   strNetwork = "LOCAL"
 End If
 
 FindQueryRange = strRangeAddress
 
End Function
'/============================================/
Private Function ChangeQueryNameToRangeName(strQueryName1)
 Dim i As Integer, x As Integer
 Dim strRngName As String
 
 strRngName = ""
 
 i = Len(strQueryName1)
 
 For x = 1 To i
   'check for:   0-9, A-Z, a-z, . , ? , _ , \
   'Range names can ONLY include these characters.
   '  All others are changed to an underscore "_"
   If Not ((Asc(Mid(strQueryName1, x, 1)) >= 48 And _
         Asc(Mid(strQueryName1, x, 1)) <= 57) _
     Or (Asc(Mid(strQueryName1, x, 1)) >= 65 And _
         Asc(Mid(strQueryName1, x, 1)) <= 90) _
     Or (Asc(Mid(strQueryName1, x, 1)) >= 97 And _
         Asc(Mid(strQueryName1, x, 1)) <= 122) _
     Or (Asc(Mid(strQueryName1, x, 1)) = 46) _
     Or (Asc(Mid(strQueryName1, x, 1)) = 63) _
     Or (Asc(Mid(strQueryName1, x, 1)) = 92) _
     Or (Asc(Mid(strQueryName1, x, 1)) = 95)) Then
     strRngName = strRngName & "_"
    Else
     strRngName = strRngName & Mid(strQueryName1, x, 1)
   End If
 Next x

 ChangeQueryNameToRangeName = strRngName

End Function
'/============================================/
Private Function BreakoutConnectionData(strConnection As _
 String) As String
 Dim strInfo As String
 
'  On Error GoTo exit_Function
 On Error Resume Next
 
 BreakoutConnectionData = strConnection
 
 BreakoutConnectionData = "Connection Source: " & _
   Left(strConnection, Application.WorksheetFunction.Find(";", _
   strConnection)) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   "Data Source Name: " & Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 1)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 2)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 1))) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   "Query Source: " & Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 2)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 3)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 2))) & _
   vbLf
 BreakoutConnectionData = _
   BreakoutConnectionData & "Default Directory: " & _
   Mid(strConnection, WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 3)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 4)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 3))) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   "Driver ID: " & Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 4)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 5)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 4))) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   "File Type: " & Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 5)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 6)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 5))) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 6)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 7)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 6))) & _
   vbLf
 BreakoutConnectionData = BreakoutConnectionData & _
   Mid(strConnection, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 7)) + 1, _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 8)) - _
   WorksheetFunction.Find("~", _
   WorksheetFunction.Substitute(strConnection, ";", "~", 7)))

exit_Function:
 

End Function
'/============================================/
'MACRO ENDS HERE

hth,