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