Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Clean up Exporting Report to Excel

Posted on 2007-11-14
3
Medium Priority
?
360 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
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 2000 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 learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

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

After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
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…

916 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