Using ADO with Pivot Tables

[Steve S]

I am using ADO recordsets to refresh existing pivot tables. The user
inputs a start and end date to cells in sheet, then clicks a custom
button to refresh. My code builds the recordset with ADO then assigns
it to the PivotCache.Recordset. I have five pivot tables, each on the
its own sheet, but even though I am resetting the recordset each time
in the code, the tables seem to be sharing the same PivotCache -- so
when I refresh one, the others are refreshed, too. This is not what I
want; each table needs to be independent.

How can I correct this? My code is below:

Public Sub UpdatePivotTable(ByRef pvt As PivotTable, ByRef strSql As
String)
' uses ADO recordset to populate pivot

Const sSOURCE As String = "UpdatePivotTable()"

Dim pvtCache As PivotCache
Dim rstData As ADODB.Recordset

On Error GoTo ErrHandler

With Application
.ScreenUpdating = False
.Cursor = xlWait
.Calculation = xlCalculationManual
.StatusBar = "Requerying database, please wait..."
End With

' open global connection object
If gCnn Is Nothing Then Call OpenAccessConnection
gCnn.Open

' populate recordset
Set rstData = New ADODB.Recordset
rstData.Open strSql, gCnn, adOpenStatic, adLockReadOnly

' check for records
If rstData.EOF Then
MsgBox "No matching records.", vbError, "No Data"
GoTo ExitHere
End If

' since there are records
' assign recordset to pivot cache and refresh
Set pvtCache = pvt.PivotCache
Set pvtCache.Recordset = rstData

' refresh pivot
With pvt
.PivotCache.Refresh
.SaveData = False
.EnableFieldDialog = False
.EnableFieldList = False
.EnableWizard = False
End With

ExitHere:
'tidy up
On Error Resume Next
Set pvtCache = Nothing
Set pvt = Nothing
rstData.Close
Set rstData = Nothing
gCnn.Close
'reset defaults
With Application
.ScreenUpdating = True
.Cursor = xlDefault
.StatusBar = False
.Calculation = xlCalculationAutomatic
End With

Exit Sub

ErrHandler:
If bCentralErrorHandler(msMODULE, sSOURCE, , True) Then
Stop
Resume
Else
Resume ExitHere
End If
End Sub