Refreshing Excel Pivots from Access

[Oleg]

Found this online
breaks on this line -->

PT.PivotCache.BackgroundQuery = True

do i have to reference anything specific ?

    Dim XL As Object
    Dim wb As Object 'Workbooks
    Dim ws As Object ' Worksheet
    Dim PT As Object ' PivotTable
 
    Set XL = CreateObject("Excel.Application")
    Set wb = XL.Workbooks.Open(".........xltx")
 
    'XL.Visible = True
    For Each ws In wb.Worksheets
        For Each PT In ws.PivotTables
            PT.PivotCache.BackgroundQuery = True
            PT.RefreshTable
        Next PT
    Next ws
    wb.Close
    XL.Quit
    Set wb = Nothing
    Set XL = Nothing

 

[Rx_]

Assuming in your Referenced (menu) you have the Excel Library checked
Suggest you use Early Binding instead of Late Binding (the word Object)

Dim ObjXL As excel.Application
Dim XLWB As excel.Workbook
Dim XLWS As excel.Worksheet
Dim PT As excel.PivotTable
ObjXL.Workbooks.Add

 

[Oleg]

i do have excel 12.0 object library referenced

do i need this line --->
ObjXL.Workbooks.Add

?

get

"Application-defined or object defined error'

 

[Rx_]

Searched and could not find a short Access VBA example. Put this together and ran it in an Access 2007 Module. It puts a few records on Sheet 1 and then creates a pivot on Sheet 2. I will be out for a few days hope this helps.

Sub MakePivotTable()
        Dim ObjXL As Excel.Application
        Dim XLWB As Excel.Workbook
        Dim XLWS As Excel.Worksheet
        Dim pt As Excel.PivotTable
        Dim strField As String
        Dim PTOutput As Excel.Worksheet
        Dim PTCache As Excel.PivotCache
        Dim PRange As Excel.Range
        Dim finalRow As Long
        Dim FinalCol As Long
Set ObjXL = New Excel.Application
ObjXL.Visible = True
ObjXL.Workbooks.Add
ObjXL.Worksheets.Add       ' Sheet 1   data
ObjXL.Worksheets.Add       ' Sheet 2   Pivot table
ObjXL.Worksheets(1).Name = "MyData"
ObjXL.Worksheets(2).Name = "MyPivot"
      Set XLWS = Excel.Worksheets(1)
      Set PTOutput = Excel.Worksheets(2)
  With ObjXL
    .Sheets(1).Select
    .Range("A1").Select
    .ActiveCell.FormulaR1C1 = "Job_Desc"
    .Range("B1").Select
    .ActiveCell.FormulaR1C1 = "Code"
    .Range("C1").Select
    .ActiveCell.FormulaR1C1 = "Years"
    .Range("A2").Select
    .ActiveCell.FormulaR1C1 = "Access"
    .Range("B2").Select
    .ActiveCell.FormulaR1C1 = "VBA"
    .Range("C2").Select
    .ActiveCell.FormulaR1C1 = "5"
    .Range("A3").Select
    .ActiveCell.FormulaR1C1 = "Access"
    .Range("B3").Select
    .ActiveCell.FormulaR1C1 = "Macro"
    .Range("C3").Select
    .ActiveCell.FormulaR1C1 = "1"
    .Range("A4").Select
    .ActiveCell.FormulaR1C1 = "Access"
    .Range("B4").Select
    .ActiveCell.FormulaR1C1 = "Linked Tables"
    .Range("C4").Select
    .ActiveCell.FormulaR1C1 = "3"
    .Range("A5").Select
    .ActiveCell.FormulaR1C1 = "DAO"
    .Range("B5").Select
    .ActiveCell.FormulaR1C1 = "Linked Tables"
    .Range("C5").Select
    .ActiveCell.FormulaR1C1 = "8"
 End With
            ' Find the last row with data
        finalRow = XLWS.Cells(ObjXL.Application.Rows.Count, 1).End(xlUp).Row
            ' Find the last column with data
        FinalCol = XLWS.Cells(1, ObjXL.Application.Columns.Count).End(xlToLeft).Column
             ' Find the range of the data
200     Set PRange = XLWS.Cells(1, 1).Resize(finalRow, FinalCol)
210     Set PTCache = ObjXL.ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
             ' Create the pivot table
240     Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(1, 1), TableName:="SamplePivot")
             ' Define the layout of the pivot table
             ' Set update to manual to avoid recomputation while laying out
300     pt.ManualUpdate = True
             ' Set up the row fields
330     pt.AddFields RowFields:=Array("Code")
             ' Set up the data fields
370     With pt.PivotFields("Years")
380         .Orientation = xlDataField
390         .Function = xlSum
400         .Position = 1
410     End With
             ' Now calc the pivot table
440     pt.ManualUpdate = False
460 End Sub