How to change connection information for a query in Excel

Sub QueryChange()
     Dim sh As Worksheet, qy As QueryTable
     Dim pt As PivotTable, pc As PivotCache
     Dim OldPath As String, NewPath As String	
     Dim rng As Range
     
     'Replace the following paths with the original path or server name
     'where your database resided, and the new path or server name where
     'your database now resides.
     OldPath =  "C:\OldPath\Folder"
     NewPath = "C:\NewPath\Folder"

     For Each ws In ActiveWorkbook.Sheets
       For Each qy In ws.QueryTables
            qy.Connection = _
                  Application.Substitute(qy.Connection, _
                  OldPath, NewPath)
            qy.CommandText = _
                  StringToArray(Application.Substitute(qy.CommandText, _
                  OldPath, NewPath))
            qy.Refresh
       Next qy

       For Each pt In ws.PivotTables
            pt.PivotCache.Connection = _
                  Application.Substitute(pt.PivotCache.Connection, _
                  OldPath, NewPath)
            On Error Resume Next
            pt.PivotCache.CommandText = _
                  StringToArray(Application.Substitute(pt.PivotCache.CommandText, _
                  OldPath, NewPath))
            If Err.Number <> 0 Then
                Err.Clear
                On Error GoTo 0
                Application.ScreenUpdating = False
                Set rng = pt.TableRange2
                pt.TableRange2.Copy Workbooks.Add(xlWorksheet).Worksheets(1) _
                           .Range("A1")
                ActiveCell.PivotTable.PivotCache.CommandText = _
                           StringToArray(Application.Substitute(pt.PivotCache.CommandText, _
                           OldPath, NewPath))
                ActiveCell.PivotTable.TableRange2.Copy pt.TableRange2
                ActiveWorkbook.Close False
                Set pt = rng.PivotTable
                Application.ScreenUpdating = True
            End If
            pt.PivotCache.Refresh
        Next pt
Next ws
End Sub

Function StringToArray(Query As String) As Variant

   Const StrLen = 127
   Dim NumElems As Integer
   Dim Temp() As String

   NumElems = (Len(Query) / StrLen) + 1
   ReDim Temp(1 To NumElems) As String

   For i = 1 To NumElems
      Temp(i) = Mid(Query, ((i - 1) * StrLen) + 1, StrLen)
   Next i

   StringToArray = Temp

End Function