problem in pivot refresh
hello
please help me
i have to commands creat and refresh
creat piovt table no problem
refresh piovt table give me error no 1004
this is code
Dim con As ADODB.Connection
Dim rst As ADODB.Recordset
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim ptCache As PivotCache
Dim ptTable As PivotTable
Dim xlCalc As XlCalculation
Dim stCon As String
Dim stSQL As String
Private Sub creat_Click()
Dim rnStart As Range
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets.Add
With wsSheet
Set rnStart = .Range("A1")
End With
wsSheet.Name = "ADO PT"
stCon = "Provider=SQLOLEDB.1;Password=1000;Persist Security Info=True;User ID=sa;Initial Catalog=main;Data Source=P1"
stSQL = "SELECT ITEMNMBR from iv00101 where ITEMNMBR like '170%' ITEMNMBR like '178%' "
ADO_Call stCon, stSQL
Set ptCache = wbBook.PivotCaches.Add(SourceType:=xlExternal)
'Add the Recordset as the source to the pivotcache.
With ptCache
Set .Recordset = rst
End With
x = ptCache.RecordCount
'Create the pivottable
Set ptTable = ptCache.CreatePivotTable(TableDestination:=rnStart , _
TableName:="PT_ADO")
End Sub
Private Sub refresh_Click()
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("ADO PT")
Set ptCache = wbBook.PivotCaches(1)
stCon = "Provider=SQLOLEDB.1;Password=1000;Persist Security Info=True;User ID=sa;Initial Catalog=main;Data Source=P1"
stSQL = "SELECT ITEMNMBR from iv00101 where ITEMNMBR like '174%' ITEMNMBR like '178%' "
ADO_Call stCon, stSQL
'Add the Recordset as the source.
Set ptCache.Recordset = rst
With wsSheet
Set ptTable = .PivotTables("PT_ADO")
End With
'Refresh the data.
ptTable.RefreshTable
'Release the Recordset from the memory.
If CBool(rst.State And adStateOpen) Then rst.Close
Set rst = Nothing
End Sub
Private Function ADO_Call(stCon As String, stSQL As String) As ADODB.Recordset
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
'Temporarily change some settings.
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Open the connection and fill the Recordset.
With cnt
.CursorLocation = adUseClient
.Open stCon
Set rst = .Execute(stSQL)
End With
'Disconnect the Recordset.
Set rst.ActiveConnection = Nothing
If CBool(cnt.State And adStateOpen) Then cnt.Close
Set cnt = Nothing
'Restore the settings.
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Function
|
