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

....

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

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

....