Question : 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.
Thanks.
Code Snippet: 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:

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
rsDir.MoveFirst
 
 
Do Until rsDir.EOF
    Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add
 
 
    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
        Next
   
   
    Sheet.Range("A11").CopyFromRecordset rs  'copy the data
    'xlObj.Visible = True
    xlObj.ActiveWorkbook.SaveAs "L:\Revenue Sharing\SubTA\" & rsDir("FUNDFAMNAM") & ".xls"
 
   
    Set Sheet = Nothing
    xlObj.Quit
    Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Function
Open in New Window Select All

Answer : Export Access to Excel using VBA

After your Set rs statement you need to do a MoveLast to ensure you have the recordcount
rs.movelast
intmaxRow = rs.RecordCount
rs.MoveFirst
Random Solutions  
 
programming4us programming4us