excel_pivot.bas

' MS Access VBA: export to Excel and create a pivot table

Dim TheDate As Date
    TheDate = Now()
  
    Dim strFilePath As String
    strFilePath = "C:\Temp\filename_" & Month(TheDate) & "-" & Day(TheDate) & "-" & Year(TheDate) & ".xls"
   
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_here", strFilePath, True
   
   '*****************************
   ' START Format the Excel
   '*****************************
    Dim objXL As Excel.Application
   
    Set objXL = New Excel.Application
    objXL.Workbooks.Open strFilePath
      
    objXL.Visible = True
      
    
    ' START CREATE PIVOT
   
    objXL.Columns("A:D").Select
   
    ' NOTE: Add the sheet in first, to ensure the destination is there BEFORE the line
    ' that sets the TableDestination
    objXL.Sheets.Add
 
 
    objXL.ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "my_query_here!R1C1:R2192C4", Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", tableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10
       
    objXL.Sheets("Sheet1").Select
 
    With objXL.ActiveSheet.PivotTables("PivotTable1").PivotFields("field_one")
        .Orientation = xlRowField
        .Position = 1
    End With
 
    With objXL.ActiveSheet.PivotTables("PivotTable1").PivotFields("field_two")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With objXL.ActiveSheet.PivotTables("PivotTable1").PivotFields("field_three")
        .Orientation = xlColumnField
        .Position = 2
    End With
   
    ' NOTE: you need to add in the field here BEFORE you pivot it in the table
    With objXL.ActiveSheet.PivotTables("PivotTable1").PivotFields("field_to_sum")
        .Orientation = xlColumnField
        .Position = 3
    End With
 
    objXL.ActiveSheet.PivotTables("PivotTable1").AddDataField objXL.ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("field_to_sum"), "Sum of field_to_sum", _
        xlSum
 
 
' END CREATE PIVOT
   
       
       
    objXL.EnableEvents = False
    objXL.DisplayAlerts = False
    objXL.SaveWorkspace
    objXL.DisplayAlerts = True
    objXL.EnableEvents = True
   
  
    objXL.SaveWorkspace
 
    'objXL.Quit
   
    Set wrksheet = Nothing
    Set objXL = Nothing