Function AccessToExcelAutomation()
  
   Dim dbLocal As Database
   Dim snpErrors As DAO.Recordset
   Dim intCurrTask As Integer
   Dim wbkNew As Excel.Workbook, wksNew As Excel.Worksheet
   Dim rngCurr As Excel.Range
   Dim ptCache As PivotCache
   Dim pRange As Range
  
  
   On Error GoTo Error_OLEAccessToExcel
  
   '-- Open the current database and projects table
   Set dbLocal = CurrentDb()
   Set snpErrors = dbLocal.OpenRecordset("Select AuditType, AudDate, ClaimNumber, " & _
   " QNotes, QNum, Question, Assignee, Auditor from qry_Errors", _
            dbOpenSnapshot)
  
   Set appExcel = New Excel.Application
   Set wbkNew = appExcel.Workbooks.Add
   Set wksNew = wbkNew.Worksheets.Add
   appExcel.Visible = True
    
   With wksNew
      '-- Create the Column Headings
      .Cells(1, 1).Value = "Audit Type"
      .Cells(1, 1).Font.Bold = True
      .Cells(1, 2).Value = "Audit Date"
      .Cells(1, 2).Font.Bold = True
      .Cells(1, 3).Value = "Claim Number"
      .Cells(1, 3).Font.Bold = True
      .Cells(1, 4).Value = "Comments"
      .Cells(1, 4).Font.Bold = True
      .Cells(1, 5).Value = "Question Number"
      .Cells(1, 5).Font.Bold = True
      .Cells(1, 6).Value = "Question"
      .Cells(1, 6).Font.Bold = True
      .Cells(1, 7).Value = "Assignee"
      .Cells(1, 7).Font.Bold = True
      .Cells(1, 8).Value = "Auditor"
      .Cells(1, 8).Font.Bold = True
   End With
  
   snpErrors.MoveLast
   snpErrors.MoveFirst
  
   Set rngCurr = wksNew.Range(wksNew.Cells(2, 1), _
             wksNew.Cells(2 + snpErrors.RecordCount, 8))
  
   '-- populates new worksheet with data from qry_Errors
   rngCurr.CopyFromRecordset snpErrors
   '-- Sets columns to auto fit and turns text wrap on, adds a pretty line.
   wksNew.Columns("A:H").AutoFit
   wksNew.Columns("A:H").WrapText = True
   With Range("A1:H1").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    '-- create pivot cache and build pivot table...
[color="red"]  ******Here is the problem***********
   Set pRange = wksNew.Cells(1, 1).Resize((1 + snpErrors.RecordCount), 8)
   Set ptCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange)
    [/color]
  
   Exit Function
  
Error_OLEAccessToExcel:
  
   Beep
   MsgBox "The Following OLE Error has occurred:" & vbCrLf & Err.Description, vbCritical, "OLE Error!"
   Set appExcel = Nothing
   Exit Function

End Function