Avatar of pbowker

asked on 

Export Access to Excel using VBA

I have VBA code that exports a table to Excel, creating separate workbooks for each group.  I also want to add totals and place them in the next available row.  Can someone assist.  I setup accumulators, but have problems on where to place the formula.  I either get only the first record or a large multiple of the number.  I've attached the original code without the totals.  I'm trying to total AverageMarketValue
I set a field called TotalMV, first set it to 0 and then added a formula TotalMV = TotalMV + rs!AverageMarketValue.  I need to know where to put the formulas and also how to count the rows to add it at the correct spot.
Function SubTA()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object
Dim db As Database
Dim lngColumns As Long
Dim strLastColumn As String
Dim cntColumns As Long
Dim cntRows As Long
Set rsDir = CurrentDb.OpenRecordset("select distinct FUNDFAMNAM from SubTABilling")
If rsDir.EOF Then Exit Function
Do Until rsDir.EOF
    Set xlObj = CreateObject("Excel.Application")
    ssql = "SELECT SubTABilling.FUNDFAMNAM, SubTABilling.FundName, SubTABilling.[Plan Name], "
    ssql = ssql & " SubTABilling.PLANID, SubTABilling.Ticker, SubTABilling.Cusip, SubTABilling.[Fund Acct #], "
    ssql = ssql & " SubTABilling.[AverageMarketValue], SubTABilling.[# Part], SubTABilling.BPS, SubTABilling.[Part Fee], "
    ssql = ssql & " SubTABilling.[Quarterly Asset Fee], SubTABilling.[Quarterly Part Fee], SubTABilling.[Total Fee] "
    ssql = ssql & " FROM SubTABilling WHERE SubTABilling.FUNDFAMNAM='" & rsDir("FundFamNam") & "'"
     Set rs = CurrentDb.OpenRecordset(ssql)
    Set Sheet = xlObj.ActiveWorkbook.Sheets("sheet1")
    'rename the sheet, you can use any of the recordset field
    'Sheet.Name = rsDir("FundFamNam")
    'copy the headers
        For iCol = 0 To rs.Fields.Count - 1
            Sheet.Cells(10, iCol + 1).Value = rs.Fields(iCol).Name
    Sheet.Range("A11").CopyFromRecordset rs  'copy the data
    'xlObj.Visible = True
    xlObj.ActiveWorkbook.SaveAs "L:\Revenue Sharing\SubTA\" & rsDir("FUNDFAMNAM") & ".xls"
    Set Sheet = Nothing
    Set xlObj = Nothing
Set rsDir = Nothing
Set rs = Nothing
End Function

Open in new window

Microsoft AccessMicrosoft Excel

Avatar of undefined
Last Comment

8/22/2022 - Mon