How to export Access Reports to Excel less DoCmd.OutputTo object?

When the customer requires you to be absurdly perfect, specially in exporting reports to Excel, the DoCmd.OutputTo object becomes utterly useless, because it throws a lot of garbage columns in your exported Excel file.   It is also useless to export directly the table source of your report to Excel because it will disregard your subtotals.  The solution is to manually create the Excel file using the Excel object provided by the Office suite through VBA code.  Below is the sample code that exports a heavy-column-report like Accounts Receivable with Aging with sub totals per customer (entity).

There are some complications of the “Filling of Record” at line 84 of the code because we’ve added a sub total routine per customer (entity).

Function GetSaveAsFileName(Optional InitialName As String) As String
    Dim FileDialog As Object
    Dim ChoosenFile As String:  ChoosenFile = ""
    Set FileDialog = Application.FileDialog(2)

    With FileDialog
        .AllowMultiSelect = False
        .InitialFileName = InitialName
        .Title = "Save as..."
    End With

    If FileDialog.Show Then
        GetSaveAsFileName = FileDialog.SelectedItems(1)
    End If
End Function

Private Sub cmdXLS_Click()
    Select Case Me.repTypevar
        Case 1:
            Dim ExcelApp As Object
            Dim ExcelWB As Object
            Dim ExcelWS As Object
            Dim ExcelRange As Object

            Dim TotalG As Double: TotalG = 0
            Dim TotalH As Double: TotalH = 0
            Dim TotalI As Double: TotalI = 0
            Dim TotalJ As Double: TotalJ = 0
            Dim TotalK As Double: TotalK = 0
            Dim TotalL As Double: TotalL = 0
            Dim TotalM As Double: TotalM = 0
            Dim TotalN As Double: TotalN = 0
            Dim TotalO As Double: TotalO = 0
            Dim TotalP As Double: TotalP = 0
            Dim TotalQ As Double: TotalQ = 0

            Dim CurrentEntity As String

            'Prepare the data source
            DoCmd.SetWarnings False
            DoCmd.RunSQL "DELETE FROM repAccountsReceivableAsOfXLS"
            DoCmd.OpenQuery "repAccountsReceivableAsOfQ002"
            DoCmd.SetWarnings True

            'Create the excel application
            Set ExcelApp = CreateObject("Excel.Application")

            'Create the excel workbook
            Set ExcelWB = ExcelApp.Workbooks.Add

            'Create the filename
            Dim FileName As String
            FileName = Nz(GetSaveAsFileName(CurrentProject.Path & "\Report.xls"), "")

            If FileName <> "" Then
                'Create the excel file
                ExcelWB.SaveAs FileName

                'Create the excel sheet
                Set ExcelWS = ExcelWB.Worksheets("Sheet1")

                'Open the excel application
                ExcelApp.Visible = True

                'Fill in the column values
                Set ExcelRange = ExcelWS.Range("A1"): ExcelRange.Value = "Customer"
                Set ExcelRange = ExcelWS.Range("B1"): ExcelRange.Value = "SI No"
                Set ExcelRange = ExcelWS.Range("C1"): ExcelRange.Value = "Manual SI No"
                Set ExcelRange = ExcelWS.Range("D1"): ExcelRange.Value = "SI Date"
                Set ExcelRange = ExcelWS.Range("E1"): ExcelRange.Value = "Terms"
                Set ExcelRange = ExcelWS.Range("F1"): ExcelRange.Value = "Due Date"
                Set ExcelRange = ExcelWS.Range("G1"): ExcelRange.Value = "SI Amount"
                Set ExcelRange = ExcelWS.Range("H1"): ExcelRange.Value = "Return Amount"
                Set ExcelRange = ExcelWS.Range("I1"): ExcelRange.Value = "Adjustment Amount"
                Set ExcelRange = ExcelWS.Range("K1"): ExcelRange.Value = "Paid Amount"
                Set ExcelRange = ExcelWS.Range("J1"): ExcelRange.Value = "Balance Amount"
                Set ExcelRange = ExcelWS.Range("L1"): ExcelRange.Value = "Aging: Current"
                Set ExcelRange = ExcelWS.Range("M1"): ExcelRange.Value = "Aging: 1-30"
                Set ExcelRange = ExcelWS.Range("N1"): ExcelRange.Value = "Aging: 31-60"
                Set ExcelRange = ExcelWS.Range("O1"): ExcelRange.Value = "Aging: 61-90"
                Set ExcelRange = ExcelWS.Range("P1"): ExcelRange.Value = "Aging: 91-120"
                Set ExcelRange = ExcelWS.Range("Q1"): ExcelRange.Value = "Aging: Above 120"

                'Fill in the record values
                Dim rs As Recordset
                Dim i As Long: i = 2
                Set rs = CurrentDb.OpenRecordset("repAccountsReceivableAsOfXLS")
                If rs.RecordCount > 0 Then
                    rs.MoveFirst
                    CurrentEntity = rs!entityName
                    Do Until rs.EOF
                        If CurrentEntity <> rs!entityName Then
                            Set ExcelRange = ExcelWS.Range("G" & Trim(Str(i))): ExcelRange.Value = TotalG
                            Set ExcelRange = ExcelWS.Range("H" & Trim(Str(i))): ExcelRange.Value = TotalH
                            Set ExcelRange = ExcelWS.Range("I" & Trim(Str(i))): ExcelRange.Value = TotalI
                            Set ExcelRange = ExcelWS.Range("J" & Trim(Str(i))): ExcelRange.Value = TotalJ
                            Set ExcelRange = ExcelWS.Range("K" & Trim(Str(i))): ExcelRange.Value = TotalK
                            Set ExcelRange = ExcelWS.Range("L" & Trim(Str(i))): ExcelRange.Value = TotalL
                            Set ExcelRange = ExcelWS.Range("M" & Trim(Str(i))): ExcelRange.Value = TotalM
                            Set ExcelRange = ExcelWS.Range("N" & Trim(Str(i))): ExcelRange.Value = TotalN
                            Set ExcelRange = ExcelWS.Range("O" & Trim(Str(i))): ExcelRange.Value = TotalO
                            Set ExcelRange = ExcelWS.Range("P" & Trim(Str(i))): ExcelRange.Value = TotalP
                            Set ExcelRange = ExcelWS.Range("Q" & Trim(Str(i))): ExcelRange.Value = TotalQ

                            TotalG = 0
                            TotalH = 0
                            TotalI = 0
                            TotalJ = 0
                            TotalK = 0
                            TotalL = 0
                            TotalM = 0
                            TotalN = 0
                            TotalO = 0
                            TotalP = 0
                            TotalQ = 0

                            CurrentEntity = rs!entityName

                            i = i + 1
                        End If

                        Set ExcelRange = ExcelWS.Range("A" & Trim(Str(i))): ExcelRange.Value = rs!entityName
                        Set ExcelRange = ExcelWS.Range("B" & Trim(Str(i))): ExcelRange.Value = rs!InvoiceNo
                        Set ExcelRange = ExcelWS.Range("C" & Trim(Str(i))): ExcelRange.Value = rs!InvoiceRefNo
                        Set ExcelRange = ExcelWS.Range("D" & Trim(Str(i))): ExcelRange.Value = rs!InvoiceDateTime
                        Set ExcelRange = ExcelWS.Range("E" & Trim(Str(i))): ExcelRange.Value = rs!Terms
                        Set ExcelRange = ExcelWS.Range("F" & Trim(Str(i))): ExcelRange.Value = rs!duedate
                        Set ExcelRange = ExcelWS.Range("G" & Trim(Str(i))): ExcelRange.Value = Nz(rs!salesAmount, 0)
                        Set ExcelRange = ExcelWS.Range("H" & Trim(Str(i))): ExcelRange.Value = Nz(rs!returnAmount, 0)
                        Set ExcelRange = ExcelWS.Range("I" & Trim(Str(i))): ExcelRange.Value = Nz(rs!debitCreditAmount, 0)
                        Set ExcelRange = ExcelWS.Range("J" & Trim(Str(i))): ExcelRange.Value = Nz(rs!paidAmount, 0)
                        Set ExcelRange = ExcelWS.Range("K" & Trim(Str(i))): ExcelRange.Value = Nz(rs!BalanceAmount, 0)
                        Set ExcelRange = ExcelWS.Range("L" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol1, 0)
                        Set ExcelRange = ExcelWS.Range("M" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol2, 0)
                        Set ExcelRange = ExcelWS.Range("N" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol3, 0)
                        Set ExcelRange = ExcelWS.Range("O" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol4, 0)
                        Set ExcelRange = ExcelWS.Range("P" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol5, 0)
                        Set ExcelRange = ExcelWS.Range("Q" & Trim(Str(i))): ExcelRange.Value = Nz(rs!AgeCol6, 0)

                        TotalG = TotalG + Nz(rs!salesAmount, 0)
                        TotalH = TotalH + Nz(rs!returnAmount, 0)
                        TotalI = TotalI + Nz(rs!debitCreditAmount, 0)
                        TotalJ = TotalJ + Nz(rs!paidAmount, 0)
                        TotalK = TotalK + Nz(rs!BalanceAmount, 0)
                        TotalL = TotalL + Nz(rs!AgeCol1, 0)
                        TotalM = TotalM + Nz(rs!AgeCol2, 0)
                        TotalN = TotalN + Nz(rs!AgeCol3, 0)
                        TotalO = TotalO + Nz(rs!AgeCol4, 0)
                        TotalP = TotalP + Nz(rs!AgeCol5, 0)
                        TotalQ = TotalQ + Nz(rs!AgeCol6, 0)

                        rs.MoveNext
                        i = i + 1
                    Loop

                    Set ExcelRange = ExcelWS.Range("G" & Trim(Str(i))): ExcelRange.Value = TotalG
                    Set ExcelRange = ExcelWS.Range("H" & Trim(Str(i))): ExcelRange.Value = TotalH
                    Set ExcelRange = ExcelWS.Range("I" & Trim(Str(i))): ExcelRange.Value = TotalI
                    Set ExcelRange = ExcelWS.Range("J" & Trim(Str(i))): ExcelRange.Value = TotalJ
                    Set ExcelRange = ExcelWS.Range("K" & Trim(Str(i))): ExcelRange.Value = TotalK
                    Set ExcelRange = ExcelWS.Range("L" & Trim(Str(i))): ExcelRange.Value = TotalL
                    Set ExcelRange = ExcelWS.Range("M" & Trim(Str(i))): ExcelRange.Value = TotalM
                    Set ExcelRange = ExcelWS.Range("N" & Trim(Str(i))): ExcelRange.Value = TotalN
                    Set ExcelRange = ExcelWS.Range("O" & Trim(Str(i))): ExcelRange.Value = TotalO
                    Set ExcelRange = ExcelWS.Range("P" & Trim(Str(i))): ExcelRange.Value = TotalP
                    Set ExcelRange = ExcelWS.Range("Q" & Trim(Str(i))): ExcelRange.Value = TotalQ

                End If

                rs.Close
                Set rs = Nothing

            End If

            'Clean the object
            Set ExcelApp = Nothing
            Set ExcelWB = Nothing
            Set ExcelWS = Nothing
            Set ExcelRange = Nothing
    End Select
End Sub

Thats it, I hope the code above is self explanatory.  There is an additional function though, the GetSaveAsFileName function, the purpose of this function is to open a dialog box so that the user can type in where he/she intends to save the XLS file.  The function is not yet perfect, I still encountered problems while adding the Filter method to the Save-As file dialog box.

Advertisements
About

Software developer living in the Philippines.

Posted in Microsoft Access
One comment on “How to export Access Reports to Excel less DoCmd.OutputTo object?
  1. ronnie valero says:

    VBA is the treasure chest of the MS Office family (including the step child named ACCESS).
    Nice share Glenn! Although Phyton is dubbed as a glue language , I don’t see any real world application implemented but just a demo and sample snippets (http://www.blog.pythonlibrary.org/2010/07/16/python-and-microsoft-office-using-pywin32/).

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Author

Harold Glenn P. Minerva
Software Developer / Tech Enthusiast
Living in the Philippines

View Harold Glenn Minerva's profile on LinkedIn

Instagram

Software Engineer - Seasonal and Range Trading Software. Magenta Trader is a powerful stock market visualization software that increases your probability of trading success.

Software Architect and Founder - Easyfis.com is a multi-tenant cloud-based Software-as-a-Service (SaaS) business app that caters to micro, small and medium trading businesses.

CTO and Co-Founder - We give your company the leverage by providing innovative software solutions products such as Point-of-Sales (POS), Financial Information System (FMIS), Payroll and DTR (HRIS), and many more.

%d bloggers like this: