How to change connection information for a query in Excel (816562)

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.

To use the following Microsoft Visual Basic for Applications (VBA) macro code in Excel, follow these steps:

1. Start Excel.
2. In an Excel workbook, press ALT+F11 to open the Visual Basic Editor.
3. On the Insert menu, click Module.
4. On the new module code sheet, type or paste the following macro code:

   
   
   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
   

5. On the File menu, click Close and Return to Microsoft Excel.
6. To save the changes to your Excel workbook, click Save on the File menu.

Note The previous code may not work as you expect if you are using shared PivotCaches, an OLAP-based PivotTables, or a Multiple Consolidation Range-based PivotTables to connect to the database.

MORE INFORMATION

If multiple PivotTables on a worksheet are derived from the same PivotTable, the subroutine does not work after it processes the first PivotTable. As of March 2003, there is no known workaround for this problem.