Solved

Clean up Exporting Report to Excel

Posted on 2007-11-14
3
356 Views
Last Modified: 2013-11-28
Hi, I'm exporting an Access report to Excel using VBA and have a few issues I need to clean up.

I'm opening and exporting the report using the below Click subroutine and then I'm formatting the Excel report using the below function. I've got a couple problems:

1. I've hardcoded the location of the exported Excel file. How can I get that information programmically? I.e. I know "DoCmd.OutputTo acReport, stDocName" prompts the user to specify the location (file path) and file name for the new exported file. How can I capture that information once the user clicks "Ok" so I can use it later on?

2. In the function I have the line "Set WS = gobjExcel.Workbooks("rpt_OverviewforExport.xls").Sheets(1)" which works fine unless there is any other instance of Excel open. How can I make this more robust so that it doesn't matter what other Excel files are open.

Any other tips/tricks/suggestions are welcome!
Thanks,

mv

Private Sub cmdOverviewRptExport_Click()
On Error GoTo Err_cmdOverviewRptExport_Click

    Dim stDocName As String
   
    stDocName = "rpt_OverviewforExport"
    DoCmd.OpenReport stDocName, acPreview
    DoCmd.OutputTo acReport, stDocName
    Set xlApp = CreateObject("excel.application")
    xlApp.Visible = True
    xlApp.Workbooks.Open ("C:\TVS\rpt_OverviewforExport.xls")
    xlApp.Application.ActiveWorkbook.RunAutoMacros (xlAutoOpen)
    Call FormatOverviewforExportRpt
    DoCmd.Close acReport, stDocName, acSave
   
Exit_cmdOverviewRptExport_Click:
    Exit Sub

Err_cmdOverviewRptExport_Click:
    MsgBox Err.Description
    Resume Exit_cmdOverviewRptExport_Click
End Sub

Function FormatOverviewforExportRpt()
    Dim gobjExcel As Excel.Application
    Dim WS As Excel.Worksheet
    Dim RNG As Excel.Range
    Set gobjExcel = GetObject(, "Excel.Application")
    Set WS = gobjExcel.Workbooks("rpt_OverviewforExport.xls").Sheets(1)

    'Set the Zoom percentage to 80%
    gobjExcel.ActiveWindow.Zoom = 80

    With WS
        'Make the column headers bold
        .Rows("1:1").Font.Bold = True
        'Format the dates
        .Columns("D:R").NumberFormat = "m/d/yyyy"
        'Set column widths
        .Columns("A:A").ColumnWidth = 14.29
        .Columns("B:B").ColumnWidth = 8.86
        .Columns("C:C").ColumnWidth = 33.29
        .Columns("D:R").ColumnWidth = 8.86
        'Set row height
        .Rows(1).RowHeight = 25.5
        'Add shading to row 1
        .Range("A1:R1").Select
        .Range("R1").Activate
         With Selection.Interior
            .ColorIndex = 15
            .Pattern = xlSolid
         End With
        'Allow text wrapping
        .Columns("A:R").WrapText = True
        'Add conditional formatting
        .Columns("D:R").FormatConditions.Delete
        .Columns("D:R").FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
            Formula1:="=TODAY()", Formula2:="1"
        .Columns("D:R").FormatConditions(1).Font.ColorIndex = 3
        .Columns("D:R").FormatConditions(1).Interior.ColorIndex = 3
        .Columns("D:R").FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
            Formula1:="=TODAY()", Formula2:="=TODAY()+14"
        .Columns("D:R").FormatConditions(2).Font.ColorIndex = 6
        .Columns("D:R").FormatConditions(2).Interior.ColorIndex = 6
    End With

End Function
0
Comment
Question by:Michael Vasilevsky
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 1

Expert Comment

by:rgagli1
ID: 20284105
Does it happen anytime Excel is open or only when this specific file is open?
0
 
LVL 10

Author Comment

by:Michael Vasilevsky
ID: 20284397
? Does what happen?

The code opens this specific file. The problem is when there is another Excel file already open, I get an invalid subscript error. Even if there is no file open, just an instance of Excel, I get the error.
HTH,

mv
0
 
LVL 6

Accepted Solution

by:
mwolfe02 earned 500 total points
ID: 20314556
1.  There are several ways to do this, but I prefer to use the code from this webpage:  http://www.mvps.org/access/api/api0001.htm

2.  Modify the first few lines of your FormatOverviewforExportRpt function to read:

Function FormatOverviewforExportRpt(gobjExcel as Excel.Application)
    Dim WS As Excel.Worksheet
    Dim RNG As Excel.Range
    Set WS = gobjExcel.Workbooks("rpt_OverviewforExport.xls").Sheets(1)

Then call this function from cmdOverviewRptExport_Click sub as follows:

Call FormatOverviewforExportRpt(xlApp)

This will force your FormatOverviewforExportRpt function to use the instance of Excel you created in the cmdOverviewRptExport_Click sub, not the first instance of Excel currently running on the computer.

Let me know if you have any other problems.

-mike
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

710 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