W
WharfRat5ddf18
I am trying to create a PivotTable from VBA code in which I first query an
external database to create an ADO recordset, then set the
PivotCache.Recordset to the ADO recordset. The problem I am having is that
all of the fields in the ADO recordset do not show up in the PivotFields
collection (however, all fields show up in the PivotCache.Recordset). No
errors show until I try to add a field to the PivotTable using a recordset
field that did not carry over from ADO. Below is the code section I am using
(still in debug mode so not as clean as it shold be). I have commented two
areas to show where I check if the recordset fields match and if the
pivottable.fields match (commented as ***).
Any suggestions will be appreciated. Thanks in advance!!
Larry
Excel 2003 with reference to Microsoft ActiveX Data Objects 2.6 Library
====================================================
Sub MakePivotTableExample()
Dim cnDBTP As ADODB.Connection
Dim rsClaims As ADODB.Recordset
Dim rsTemp As ADODB.Recordset
Dim pvtTable As PivotTable
Dim pvtField As PivotField
Dim pvtCache As PivotCache
Dim sSQL As String
Set cnDBTP = New ADODB.Connection
Set rsClaims = New ADODB.Recordset
'make connection to dbtp
cnDBTP.CursorLocation = adUseClient
cnDBTP.ConnectionString = _
"Provider=IBMDADB2.1;" & _
"Persist Security Info=False;" & _
"User ID=u831;" & _
"Password=04jess;" & _
"Data Source=DBTP;" 'Location='';Extended Properties=''"
cnDBTP.Open
'get claims data
rsClaims.CursorLocation = adUseClient
sSQL = "SELECT CLMS_CLAIM_NO, " & _
" CLMS_DATE_RECEIVED, " & _
" CLMS_ORIG, CLMS_DEST, " & _
" CLMS_ORIGINAL_AMT, CLMS_PAYMENT_AMT, " & _
" CLMS_CLAIM_REAS " & _
"FROM YELLOW.CLCLMS " & _
"WHERE (CLMS_DATE_RECEIVED BETWEEN '3/1/2008' AND '3/31/2008') "
& _
" AND (CLMS_CLAIM_REAS In ('10','11','40','41')) " & _
"WITH UR"
rsClaims.Open sSQL, cnDBTP, adOpenStatic, adLockOptimistic, adCmdText
'make pivot table
Set pvtCache = ActiveWorkbook.PivotCaches.Add(xlExternal)
Set pvtCache.Recordset = rsClaims
Set rsTemp = pvtCache.Recordset
'check that the pvottable recordset has all fields as ADO recordset
'*** they match!!
For i = 0 To rsClaims.Fields.Count - 1
Debug.Print rsClaims.Fields(i).Name, pvtCache.Recordset.Fields(i).Name
Next
With pvtCache
.CreatePivotTable Range("B6"), "ClaimsByType"
End With
Set pvtTable = ActiveSheet.PivotTables("ClaimsByType")
'loop through pivotfields to se if they match ADO recordset
'*** they do not match!!
'2 fields left off: CLMS_ORIGINAL_AMT and CLMS_PAYMENT_AMT
For Each pvtField In pvtTable.PivotFields
Debug.Print pvtField.Name
Next
With pvtTable
.SmallGrid = False
With .PivotFields("CLMS_CLAIM_REAS")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("CLMS_ORIGINAL_AMT")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
End With
With .PivotFields("CLMS_PAYMENT_AMT")
.Orientation = xlDataField
.Function = xlSum
.Position = 2
End With
With .PivotFields("CLMS_CLAIM_NO")
.Orientation = xlDataField
.Function = xlCount
.Position = 3
End With
End With
End Sub
external database to create an ADO recordset, then set the
PivotCache.Recordset to the ADO recordset. The problem I am having is that
all of the fields in the ADO recordset do not show up in the PivotFields
collection (however, all fields show up in the PivotCache.Recordset). No
errors show until I try to add a field to the PivotTable using a recordset
field that did not carry over from ADO. Below is the code section I am using
(still in debug mode so not as clean as it shold be). I have commented two
areas to show where I check if the recordset fields match and if the
pivottable.fields match (commented as ***).
Any suggestions will be appreciated. Thanks in advance!!
Larry
Excel 2003 with reference to Microsoft ActiveX Data Objects 2.6 Library
====================================================
Sub MakePivotTableExample()
Dim cnDBTP As ADODB.Connection
Dim rsClaims As ADODB.Recordset
Dim rsTemp As ADODB.Recordset
Dim pvtTable As PivotTable
Dim pvtField As PivotField
Dim pvtCache As PivotCache
Dim sSQL As String
Set cnDBTP = New ADODB.Connection
Set rsClaims = New ADODB.Recordset
'make connection to dbtp
cnDBTP.CursorLocation = adUseClient
cnDBTP.ConnectionString = _
"Provider=IBMDADB2.1;" & _
"Persist Security Info=False;" & _
"User ID=u831;" & _
"Password=04jess;" & _
"Data Source=DBTP;" 'Location='';Extended Properties=''"
cnDBTP.Open
'get claims data
rsClaims.CursorLocation = adUseClient
sSQL = "SELECT CLMS_CLAIM_NO, " & _
" CLMS_DATE_RECEIVED, " & _
" CLMS_ORIG, CLMS_DEST, " & _
" CLMS_ORIGINAL_AMT, CLMS_PAYMENT_AMT, " & _
" CLMS_CLAIM_REAS " & _
"FROM YELLOW.CLCLMS " & _
"WHERE (CLMS_DATE_RECEIVED BETWEEN '3/1/2008' AND '3/31/2008') "
& _
" AND (CLMS_CLAIM_REAS In ('10','11','40','41')) " & _
"WITH UR"
rsClaims.Open sSQL, cnDBTP, adOpenStatic, adLockOptimistic, adCmdText
'make pivot table
Set pvtCache = ActiveWorkbook.PivotCaches.Add(xlExternal)
Set pvtCache.Recordset = rsClaims
Set rsTemp = pvtCache.Recordset
'check that the pvottable recordset has all fields as ADO recordset
'*** they match!!
For i = 0 To rsClaims.Fields.Count - 1
Debug.Print rsClaims.Fields(i).Name, pvtCache.Recordset.Fields(i).Name
Next
With pvtCache
.CreatePivotTable Range("B6"), "ClaimsByType"
End With
Set pvtTable = ActiveSheet.PivotTables("ClaimsByType")
'loop through pivotfields to se if they match ADO recordset
'*** they do not match!!
'2 fields left off: CLMS_ORIGINAL_AMT and CLMS_PAYMENT_AMT
For Each pvtField In pvtTable.PivotFields
Debug.Print pvtField.Name
Next
With pvtTable
.SmallGrid = False
With .PivotFields("CLMS_CLAIM_REAS")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("CLMS_ORIGINAL_AMT")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
End With
With .PivotFields("CLMS_PAYMENT_AMT")
.Orientation = xlDataField
.Function = xlSum
.Position = 2
End With
With .PivotFields("CLMS_CLAIM_NO")
.Orientation = xlDataField
.Function = xlCount
.Position = 3
End With
End With
End Sub