Pivot Table From MS Query
When you use MS Query to return data to an excel sheet you can store
parameters in a cell or you can have the query prompt users for input.
When you want the query results to be used in a pivot table you cannot have
parameters.
I had some code that used a Microsoft Access Query to get around this. The
query output goes into a pivot cache. I'm attempt to convert that code to use
MS Query rather than Access as I've experienced better response time.
The previous code to get the data from Acces appears below. The converted
code appears further below.
The pivot table generated by the new code does not include all of the fields
produced by the query. I'm getting vendor name (ASNAME), and invoice number
(AIINV) but not the invoice amount (AIORIG).
It appears that the pivot table is created before the complete record set
has been obtained. If anyone has any suggestions I would greatly appreciate
it.
This is the code for the Access Query:
Code:
Set Conn = New ADODB.Connection
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source =
\\server name\Accounting\Excel Reports\Report.mdb"
Conn.Open
Set objCmd.ActiveConnection = Conn
objCmd.CommandText = "EmpTranDetail" '< --- Enter the apppropriate Query
objCmd.CommandType = adCmdStoredProc
'Create the parameter and populate it.
Set objParam = objCmd.CreateParameter("@StartDate", adNumeric,
adParamInput, 0, 0)
objCmd.Parameters.Append objParam
objCmd.Parameters("@StartDate") = Range("StartDate").Value 'Return
sales for this department
Set objParam = objCmd.CreateParameter("@EndDate", adNumeric,
adParamInput, 0, 0)
objCmd.Parameters.Append objParam
objCmd.Parameters("@EndDate") = Range("EndDate").Value 'Return sales
for this department
'Open the recordset
rs.Open objCmd
'Populate the pivot table cache from the record set
Set ObjPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set ObjPivotCache.R[/html]ecordset = rs
....
This is the converted code to use MS Query:
Code:
Private Sub Import_Click()
On Error GoTo Err_cmdImport_Click
Dim Conn As New ADODB.Connection
Dim objCmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim ObjPivotCache As PivotCache
Dim ptOld As PivotTable
Dim pt As PivotTable
Dim strCmd As String
Dim ws As Worksheet
Dim wsTemp As Worksheet
Set ws = ActiveSheet
Set ptOld = ws.Cells(3, 1).PivotTable
MinVendNum = InputBox("Enter the Minimum Vendor Number", "U s e r I n
p u t R e q u i r e d")
MaxVendNum = InputBox("Enter the Maximum Vendor Number", "U s e r I n
p u t R e q u i r e d")
Application.Calculation = xlCalculationManual
Set AS400Conn = New ADODB.Connection
AS400Conn.Open "Provider=IBMDA400;Data Source=1.1.1.1", "", ""
QueryString = "SELECT APSUPP.ASNUM, APSUPP.ASNAME, APOPEN.AIINV,
APOPEN.AIDTIV, APOPEN.AIORIG"
QueryString = QueryString + " FROM TSC1.MMTSCLIB.APSUPP APSUPP LEFT
OUTER JOIN TSC1.MMTSCLIB.APOPEN APOPEN ON APSUPP.ASNUM = APOPEN.AINUM"
QueryString = QueryString + " WHERE (APSUPP.ASNUM=" & MinVendNum & "
And APSUPP.ASNUM<= " & MaxVendNum & ")"
QueryString = QueryString + " ORDER BY APSUPP.ASNUM"
'Open the recordset
Set rs = AS400Conn.Execute(QueryString, , adCmdText)
'Populate the pivot table cache from the record set
Set ObjPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
Set ObjPivotCache.Recordset = rs
'create a temporary sheet and pivot table to use the new cache
Set wsTemp = Worksheets.Add
Set pt = ObjPivotCache.CreatePivotTable _
(TableDestination:=wsTemp.Range("A3"), TableName:="Temp")
'change old pivot table to use the new cache
ptOld.CacheIndex = pt.CacheIndex
'delete the temporary sheet and pivot table
Application.DisplayAlerts = False
On Error Resume Next
wsTemp.Delete
Application.DisplayAlerts = True
Exit_cmdImport_Click:
Set ObjPivotCache = Nothing
Set rs = Nothing
Set objCmd = Nothing
Set Conn = Nothing
'Toggle off the display of the pivot table field list
ActiveWorkbook.ShowPivotTableFieldList = False
Exit Sub
Err_cmdImport_Click:
MsgBox Err.Description
Resume Exit_cmdImport_Click
End Sub
In another module I copy the record set into the sheet (code below) so I
know that they query is okay.
Code:
Set SalesRecords = AS400Conn.Execute(QueryString, , adCmdText)
'Sets the routine to the first empty row
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
SpreadsheetLine = ActiveCell.Row
'Load a couple of iSeries fields into cells...
If Not SalesRecords.EOF Then
Range("A3").CopyFromRecordset SalesRecords
On Error Resume Next
End If
....
Sincerely
Jim P
|
