Get Sum(totals) after exporting to Excel

[jsdba]

I'm wondering how i can calculate totals after i export some data from access to excel (using CopyFromRecordset). I'd like to put the total the row after the last row of data similar to how one use to AutoSum in excel. Any help is appreciated.

 

[Rx_]

Typically, using VBA code instead of the built in function would be necessary.

One of the problems will be that the data area could be 0 records or 100 records. So, where will the total go unless it knows the RecordCount?

Here is a code example of copying a query to a specific workbook.
Lets say that after the Recordset was created, there was a variable to hold the Recordset Count. e.g. MyRecordCount as a variable

Then, this code could have a 2nd query that used the SUM of the first for a specific column. Put that in a variable RS2

The data in this example starts at A2. Lets use the example of 100 records in a Recordset Count. e.g. MyRecordCount

Lets say the total was in Column C. So the line:
xlWSh.Range("C" & MyRecordCount +2).CopyFromRecordset rst2
would put the 2nd recordset's Summary at the bottom of the data range.

There are so many more ways to accomplish the same thing. If you have specific Excel questions (including programming) be sure to look up the Excel forum.
http://www.access-programmers.co.uk/forums/forumdisplay.php?f=53

Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field   
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
   
On Error GoTo err_handler    
strPath = “SET YOUR PATH TO THE WORKBOOK HERE OR USE A DIALOG TO GET IT”   
Set rst = CurrentDb.OpenRecordset(strTQName)   
Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Open(strPath)
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets(strSheetName)
  
    xlWSh.Activate
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next   
    rst.MoveFirst
 
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = True
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select   
    rst.Close
    Set rst = Nothing   
Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

Please be sure to post your finished example so others can learn.

 

[jsdba]

Solution below:

Sub exportExpense()
'Step 1: Declare variables
    Dim lngColumn As Long
    Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
    Dim curTotalExpense As Currency
    
    curTotalExpense = Nz(DLookup("FeesTotal", "qryExpenseExportTotal"), 0)
    blnEXCEL = False
    blnHeaderRow = True
    
'Step 2: Create Excel Application Object
    On Error Resume Next
        Set xlx = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlx = CreateObject("Excel.Application")
        blnEXCEL = True
    End If
        Err.Clear
    On Error GoTo 0
        'Set Excel to visible while code is running
        xlx.Visible = True
    
'Step 3: declare actual path and filename of the EXCEL
'file into which you will write the data
    Set xlw = xlx.Workbooks.Open("P:\Design2147 Database\Reports\Expense Report.xltm")
    
'Step 4: Set WorksheetName with the actual
'name of the worksheet in the EXCEL file
    Set xls = xlw.Worksheets("Expense List")
    
'Step 5: Set cell reference into which the
'first data value is to be written
    Set xlc = xls.Range("A2")
    Set dbs = CurrentDb()
    
'Step 6: Set name of the table or query
'whose data are to be written into the worksheet
    Set rst = dbs.OpenRecordset("qryExpenseExport", dbOpenDynaset, dbReadOnly)
    
'Step 7: Copy recordset tospreadsheet
    If rst.EOF = False And rst.BOF = False Then
      rst.MoveFirst
        xlc.CopyFromRecordset rst
        '\\add some formatting
            xlx.ActiveSheet.Cells.Select
            xlx.ActiveSheet.Cells.EntireColumn.AutoFit
    End If
'\\Sub Insert expense total into spreadsheet
     GetLastRow xlc, curTotalExpense
    
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing
    
'Step 7:  Clean up the EXCEL objects
    Set xlc = Nothing
    Set xls = Nothing
    'xlw.Close False   ' close the EXCEL file and save the new data
    Set xlw = Nothing
    'If blnEXCEL = True Then xlx.Quit
    Set xlx = Nothing
End Sub

Find last row of data in spreadsheet and insert total 2 row down.

Sub GetLastRow(MyRange As Excel.Range, ExpenseTotal As Currency)
    Dim lngLastRow As Long

    With MyRange.Worksheet
        lngLastRow = .Cells(.Rows.Count, MyRange.Column).End(xlUp).Row
        .Range("I" & lngLastRow + 2) = ExpenseTotal
    End With
End Sub

 

[Rx_]

Thanks for a great post using Code tags. Nicely done.

One more thing, you used "late binding" setting Excel as an object. That does work just fine and will work with different versions of Excel.

If you happen to know all client workstations will be using the same version of Excel (as the developer too) then Early Binding will make the programming troubleshooting easier.
In your Code module, Tools - References - find Microsoft Excel and check the box.
Then, instead of declaring xlc as a generic Object, declare it as Excel.Application
The biggest advantage is, this will turn on intellesense as you type code.

 

[jsdba]

Thanks for the early binding tip.