Ok, I think you reached the max. number of characters i a messagebox.
This one makes a new sheet and places the information there.
Sub GetPivotConnection()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim vtemp As Variant
Dim lCnt As Long
'add a new worksheet
On Error Resume Next
Set wsNew = Worksheets("Connectionstrings")
If Not wsNew Is Nothing Then
wsNew.Cells.ClearContents
Else
Set wsNew = Worksheets.Add
wsNew.Name = "Connectionstrings"
End If
On Error GoTo 0
'set header
wsNew.Range("A1:C1") = Array("Worksheet", "Pivot name", "Connection")
wsNew.Range("A1:C1").Font.Bold = True
'loop through each worksheet in the active workbook
For Each ws In ActiveWorkbook.Worksheets
'for each pivottable, get the pivotcache's connectionstring
For Each pt In ws.PivotTables
'take the databasestring out of the connectionstring
vtemp = Split(pt.PivotCache.Connection, ";")
'display the worksheets, pivottables and their databases in new worksheet
lCnt = lCnt + 1
wsNew.Range("A1:C1").Offset(lCnt, 0) = Array(ws.Name, pt.Name, vtemp(2))
Next
Next
wsNew.Columns("A:C").AutoFit
End Sub
BR
Tommy Bak