Excel macro to change location of .cub files used by pivot tables? (to allow .xls files that depend on .cub files to be moved)

Question

I often use Excel with pivot tables based on .cub files for OLAP-type analysis. This is great except when you want to move the xls and you realise internally it's got a non-relative reference to the location of the .cub file. How can we cope with this - ie make it convenient to move around xls files that depend on .cub files?

The best answer I could come up with is writing a macro that updates the pivot tables' reference to the .cub file location....so I'll pop that in an answer.

Answer 1

Here's the macro I ended up with. Clearly this makes some assumptions that might not be right for you, e.g. it updates all pivot tables in the workbook to use the same .cub file.

It loops through the workbook's Pivot Table connections to use a .cub file with the same name as this .xls file, in the same directory. This assumes that the PivotCaches are not using LocalConnections - check that ActiveWorkbook.PivotCaches(1).UseLocalConnection = False.

Sub UpdatePivotTableConnections()
    Dim sNewCubeFile As String
    sNewCubeFile = ActiveWorkbook.Path & Replace(ActiveWorkbook.Name, ".xls", ".cub", , , vbTextCompare)

    Dim iPivotCount As Integer
    Dim i As Integer
    iPivotCount = ActiveWorkbook.PivotCaches.Count

    ' Loop through all the pivot caches in this workbook. Use some 
    ' nasty string manipulation to update the connection.
    For i = 1 To iPivotCount
    With ActiveWorkbook.PivotCaches(i)
        ' Determine which cub file the PivotCache is currently using
        Dim sCurrentCubeFile As String
        Dim iDataSourceStartPos As Integer
        Dim iDataSourceEndPos As Integer
        iDataSourceStartPos = InStr(1, .Connection, ";Data Source=", vbTextCompare)
        If iDataSourceStartPos > 0 Then
            iDataSourceStartPos = iDataSourceStartPos + Len(";Data Source=")
            iDataSourceEndPos = InStr(iDataSourceStartPos, .Connection, ";", vbTextCompare)
            sCurrentCubeFile = Mid(.Connection, iDataSourceStartPos, iDataSourceEndPos - iDataSourceStartPos)

            ' If the PivotCache is using a different cub file then update the connection to use the new one.
            If sCurrentCubeFile <> sNewCubeFile Then
                .Connection = Left(.Connection, iDataSourceStartPos - 1) & sNewCubeFile & Right(.Connection, Len(.Connection) - iDataSourceEndPos + 1)
            End If
        End If
    End With
    Next i
End Sub