Solved

Automate exporting pivot table from access to excel

Posted on 2009-07-08
28
1,006 Views
Last Modified: 2012-05-07
I am trying to automate in Access 2003 exporting a pivot table to Excel 2003 and retaining the pivot format.

Basically, I am trying to automate the manual process of:
1) opening a query in Access in pivot table view,
2) selecting all (Ctrl A) then
3) pasting into Excel.

I tried the following but it copies the raw data into Excel and loses the pivot formatting:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "qTest", "c:\test.xls", False

I also tried the following the code (see code section) from another EE question (#21973564) and I'm getting the following errors:

WB.Columns.AutoFit -> Object doesn't support this property or method
WB.Sheets(1).pivottables(1).Refresh ->Unable to get the PivotTables property of the Worksheet class

Are these errors caused by the fact that it was written for excel 2000 and I'm using Excel 2003?

Any suggestions?

Thanks


DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qTest", "c:\test.xls", False
    
    'Declare and Start Microsoft Excel 2000.
    Dim AppExcel As Object, WB As Object
    Set AppExcel = CreateObject("Excel.Application")
    Set WB = AppExcel.Workbooks.Open("c:\test.xls")
    AppExcel.Visible = True
    WB.Columns.AutoFit
           
    WB.Sheets(1).pivottables(1).Refresh
           
    'Quit Microsoft Excel and release the object variable.
    AppExcel.Quit
    Set AppExcel = Nothing
    Set WB = Nothing

Open in new window

0
Comment
Question by:mph23
  • 12
  • 8
  • 4
  • +2
28 Comments
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802301
Think you need to use autofit on a worksheet object not a workbook object, also declare workbook and excel as Excel.Application and Workbook respectively (you need to add the excel libray reference in tools>references
 
0
 
LVL 9

Expert Comment

by:suvmitra
ID: 24802336
1) SUbmit the entire sub procedure here...please do not post partial.
2) If you disable automatic refresh then it won't export and you have to re-enter the data, however if you select automatic refresh it exports it inot excel - no problem.
3) When you have exported the data into excel and it creates the htm page, select on the pivot table toolbar and select table options and check the refresh on open checkbox.
4) DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Table1", "D:\Book1.xls", False, "Sheet1$"
5) Use the Excel Object Model and manually export it. But first you need to generate a SQL statement that will be a duplication of your pivot table. Then save it as a query. After you have that you can easily do a .TransferSpreadSheet to a specific workbook and sheet/range.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "PivotQuery1", "D:\Book1.xls", False, "Sheet2$"
6) See the code example

Private Sub ExportPivotTable()
'Add a reference to MS Office xx.0 Object Library
Dim oCBPT As Office.CommandBarPopup
Dim oCBEPT As Office.CommandBarButton
 
Set oCBPT = Application.CommandBars("Menu Bar").Controls("&PivotTable")
Set oCBEPT = oCBPT.Controls("E&xport to Microsoft Office Excel")
oCBEPT.Execute
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802372
Here's a fix for the autofit - you need to apply the method to a worksheet object, not a workbook object...
Option Compare Database
Option Explicit
 
 
Sub ExportQuery()
 
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qTest", "c:\test.xls", False
    
    'Declare and Start Microsoft Excel 2000.
    Dim AppExcel As Excel.Application
    Dim WB As Workbook
    Dim ws As Worksheet
    
    Set AppExcel = New Excel.Application
    Set WB = AppExcel.Workbooks.Open("c:\test.xls")
        
    AppExcel.Visible = True
    
    Set ws = WB.Worksheets("qtest")
    ws.Columns.AutoFit
    ws.Rows.AutoFit
    WB.Sheets(1).pivottables(1).Refresh
           
    'Quit Microsoft Excel and release the object variable.
    AppExcel.Quit
    Set AppExcel = Nothing
    Set WB = Nothing
 
End Sub

Open in new window

0
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 

Author Comment

by:mph23
ID: 24802502
mongoose:

I am getting a Type Mismatch error on the following line:

    Set WB = AppExcel.Workbooks.Open("c:\test.xls")

I see the parameters for Open is filename as a string so is WB setting the mismatch error?

0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802522
Have you set a reference to the excel library? Tools>References>Microsoft Excel (version) Library
 
0
 

Author Comment

by:mph23
ID: 24802536
mongoose:

I put Excel. in front of the dim WB and dim ws and that mismatch error went away.

Now, I'm getting the following error on the docmd.transferspreadsheet...

Run-time error '3010':
Table 'qTest' already exists.

???
0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802560
Try deleting the file "c:\test.xls" and run again - you may need to add
if dir("c:\test.xls" ) <> "" then
kill "c:\test.xls"
end if
 
0
 

Author Comment

by:mph23
ID: 24802563
mongoose:

Yes, I set the reference to the excel library.

Got pass that error, now getting 'Unable to get the PivotTables property of the Worksheet class' error on the following line:

  WB.Sheets(1).pivottables(1).Refresh
0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802730
looking at your code, the process exports the query data to the spreadsheet, but does not create apivot table - one option would be to change your query to a cross tab query and perform the pivot in access - thus removing the need to run a pivot table process - I've not done any automated pivots from access in excel, but will have a look at the code and see how it works...
0
 

Author Comment

by:mph23
ID: 24802751
When I tried a crosstab query, it didn't allow me to have more than 3 row headings (I have 4).
0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24802910
You should be able to have more than 3 row headings, you could concatenate them:
 
e.g. NewColumn: [Field 1] & " - " & [Field2]
0
 
LVL 33

Assisted Solution

by:Rob Henson
Rob Henson earned 150 total points
ID: 24803195
Hiow about a completely different angle?

Set up a pivot table in Excel with an external data source, that being the query in Access.

Then there is no need to do any exporting, the formatting can be done as you like in Excel.

Cheers
Rob H
0
 
LVL 10

Assisted Solution

by:therealmongoose
therealmongoose earned 100 total points
ID: 24803374
Here's some code that builds the pivot table in excel from access - you will need to modify this to suit your query output, but hopefully this will give you a start...
Option Compare Database
Option Explicit
 
' Ensure there is a reference to the Excel object Library,
' Choose Tools > References> Microsoft Excel (version) Library
 
Dim xlApp As Excel.Application
Dim xlWB As Workbook
Dim xlWS As Worksheet
 
Sub RunExportAndFormatProcess()
 
    Dim strQuery As String
    Dim strOutFile As String
    Dim strWorksheetName As String
    
    strQuery = "qryOutput_Data"
    strOutFile = "c:\temp.xls"
    strWorksheetName = "Worksheet New Name"
 
    ExportToExcel strQuery, strOutFile, strWorksheetName
    BuildPivot strOutFile, strWorksheetName
    
 
End Sub
 
Sub ExportToExcel(strNameOfQuery As String, strOutputFile As String, strWorksheetName As String)
 
On Error GoTo ExportToExcel_error
    
    If Dir(strOutputFile) <> "" Then
        If MsgBox(strOutputFile & " already exists - Overwrite?", vbYesNo) = vbYes Then
            Kill strOutputFile
        Else
            Exit Sub
        End If
    End If
        
    DoCmd.OutputTo acOutputQuery, strNameOfQuery, acFormatXLS, strOutputFile, False
    
    Set xlApp = New Excel.Application
    Set xlWB = xlApp.Workbooks.Open(strOutputFile)
    Set xlWS = xlWB.Worksheets(1)
    
    xlWS.Name = strWorksheetName
    xlWB.Save
    
    Set xlWS = Nothing
    xlWB.Close
    Set xlWB = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    
ExportToExcel_exit:
 
    Exit Sub
    
ExportToExcel_error:
    
    If Err.Number = 70 Then
        MsgBox "The file " & strOutputFile & " is currently already open and cannot be overwritten - close the file and rerun the process"
    Else
        MsgBox Err.Number & " - " & Err.Description
        Resume ExportToExcel_exit
    End If
    
End Sub
 
Sub BuildPivot(strWorkbook As String, strWorkSheet As String)
    
    Dim lngRow As Long
    Dim lngCol As Long
        
    Set xlApp = New Excel.Application
    Set xlWB = xlApp.Workbooks.Open(strWorkbook)
    Set xlWS = xlWB.Worksheets(strWorkSheet)
    
    'Work out the last cell in the spreadsheet with data in...vv
    
    lngCol = 1
    
    Do Until xlWS.Cells(1, lngCol) = ""
        lngCol = lngCol + 1
    Loop
    
    lngCol = lngCol - 1
    
    If lngCol = 0 Then
        MsgBox "No Data in spreadsheet..."
        Set xlWS = Nothing
        xlWB.Close False
        xlApp.Quit
        Exit Sub
    End If
    
    xlApp.Visible = True
    
    lngRow = 1
    
    Do Until xlWS.Cells(lngRow, 1) = ""
        lngRow = lngRow + 1
    Loop
    
    lngRow = lngRow - 1
    
    '...................^^
    
    xlWB.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="'" & strWorkSheet & "'!R1C1:R" & lngRow & "C" & lngCol).CreatePivotTable TableDestination:="", TableName:="Pivot Table", DefaultVersion:=xlPivotTableVersion10
    
    'Assumes column 1 contains row headings
    With xlWB.ActiveSheet.PivotTables("Pivot Table").PivotFields(CStr(xlWS.Cells(1, 1).Value))
        .Orientation = xlRowField
        .Position = 1
    End With
    
    'assumes column 3 has Column Heading values
    With xlWB.ActiveSheet.PivotTables("Pivot Table").PivotFields(CStr(xlWS.Cells(1, 3).Value))
        .Orientation = xlColumnField
        .Position = 1
    End With
        
    'Assume data to be summed is in column 4
    
    xlWB.ActiveSheet.PivotTables("Pivot Table").AddDataField ActiveSheet.PivotTables("Pivot Table").PivotFields(CStr(xlWS.Cells(1, 4).Value)), "Sum of " & CStr(xlWS.Cells(1, 4).Value), xlSum
    ActiveWorkbook.ShowPivotTableFieldList = False
   
End Sub

Open in new window

0
 

Author Comment

by:mph23
ID: 24806539
Thanks for the code.

When I compile the code, II get an error on the xlWB methods:

xlWB.Save
xlWB.Close

Method or data member not found.


0
 

Author Comment

by:mph23
ID: 24806566
Never mind, I added Excel to the declaration and it's ok.

Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet

Working on displaying more row headings. It only displays one right now but it looks like it's working.

0
 

Author Comment

by:mph23
ID: 24807105
Yeah, it works but I noticed that I can't run it twice.

I'm calling it from a button click event on a form.
When I press the button the second time without closing the form, I get an error:

Run-time error '91';
Object variable or With block variable not set

Error occurs on line #124 in your example code above:
 xlWB.ActiveSheet.PivotTables("Pivot Table").AddDataField ActiveSheet.PivotTables("Pivot Table").PivotFields(CStr(xlWS.Cells(1, 4).Value)), "Sum of " & CStr(xlWS.Cells(1, 4).Value), xlSum:

If I close the form and try it again, it works fine.

Any ideas?
0
 
LVL 16

Accepted Solution

by:
Jerry Paladino earned 250 total points
ID: 24810287
MPH,
May I suggest another path....   Why not use the data from Access as external data to create the Pivot Table in Excel.  You can start from the Excel Data menu and either use the Pivot Table option or use the Import External Data option.    Then build your pivot table in Excel using the Access data instead of trying to move the Access Pivot Table to Excel.  Screen shots of the steps for the two different paths are in the attached PDF files.
In the "Choose Data Source" dialog box, be sure to uncheck the box at the bottom that says:   Use the query wizard to create / edit queries.  
HTH,
Jerry

Excel-2003---Create-Pivot-Table-.pdf
Excel-2003---Create-Pivot-Table-.pdf
0
 

Author Comment

by:mph23
ID: 24810413
THanks, I'll give it a try and let you know how it goes.

0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 24815004
Thats exactly what I suggested yesterday!!

Prodops has given more detail with instructions etc, but still the same idea.

Cheers
Rob H
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 24815359
Sorry guys, I did not read every post. I will back out of this question. No points please.

Thanks,
Jerry
0
 
LVL 33

Expert Comment

by:Rob Henson
ID: 24815801
Jerry

No worries, no offence taken or anything. If OUR solution gets accepted then you deserve at least some of the points for the more detailed instructions.

Cheers
Rob H
0
 

Author Comment

by:mph23
ID: 24815852
Yes, the detailed instructions really helped because I was trying unsuccessfully to do it on my own earlier.

I haven't finished testing. Will keep you posted.

Thanks!
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 24816044
Thaks Rob. I am usually more careful about that. I appreciate your understanding.

Jerry
0
 

Author Comment

by:mph23
ID: 24816477
Prodops,

Are both pdf fiiles the same?
On the screen, the sizes show different but when I open the files, they look the same.

???
0
 

Author Comment

by:mph23
ID: 24816513
Never mind, I see they're slightly different in the first page.
0
 

Author Closing Comment

by:mph23
ID: 31601047
Thank you to therealmongoose, robhenson and prodops for all your help. I learned lots of different things in this post and appreciate your support. I awarded points to all of you because all of the solutions worked and gave me different ways to solve the problem.

I awarded the most points to prodops because it was his detailed instructions that helped me the most to the final solution. When robhenson initially suggested the method, I tried it but couldn't get it to work so I turned to therealmongoose solution but couldn't get that to work consistently.

Thanks!
0
 
LVL 10

Expert Comment

by:therealmongoose
ID: 24817248
Glad you got a working solution and thanks for taking the time to post your feedback!
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 24820246
MPH,
Thanks for the comments and glad you were able to solve the problem.
Rob H.  - Again - sorry for not reading all the posts more carefully!  I owe you one...
All the Best.
Jerry
0

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question