Pivot Table From MS Query

[JH Palmer]

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:

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:

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.

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