Open Excel One Workbook Multiple Sheets from MS Access

[BikeToWork]

I am trying to generate one workbook with multiple worksheets from Access but so far I have not figured out how to do this. How does one go about taking 3 separate Access DAO recordsets and generate the same workbook with a separate worksheet per RS? I imagine it can be done, but am not sure how to go about doing it. By the way, the code for generating the Workbook with one individual worksheet is working fine. I would just like to generate all worksheets at once in the same workbook instead of just one sheet per each workbook.

[NeoPa]

There are many ways of doing it so posting your existing code would help us to give suggestions that match your approach. Otherwise we could post all sorts of stuff that would be perfectly correct, yet not very helpful for you.

[twinnyfo]

Or, in case you did not know that this existed, there is this basic code to add a worksheet to Excel:

ActiveWorkbook.Sheets.Add()

But, as NeoPa said, without knowing more about what your end result is to be, this would simply be a starting point.

[BikeToWorkHome]

Here is the code attempting to open each RS as a separate sheet on the same workbook (failing)

Private Sub cmdAllReportsExcel_Click()
Dim RS As DAO.Recordset
Dim strSQL As String
Dim strPath As String
Dim strDB_Name As String
Dim strExcelPath As String
Dim strCaption As String
Dim WKB_Path As String
Dim DB As DAO.Database
Set DB = CurrentDb
Dim WKB As Excel.Workbook
Dim XLApp As Excel.Application
 
'Six Block Report**********************************
strSQL = "qry_6Block_RPT_RS"
Set RS = DB.OpenRecordset(strSQL)
strDB_Name = DB.Name
strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
 
WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
WKB_Path = WKB_Path & "ExcelData\"
Set XLApp = New Excel.Application
 
Set WKB = XLApp.Workbooks.Add(strExcelPath)
strCaption = "WAH"
 
'6 Block Report*************************************
SixBlockReport RS, WKB, strCaption, WKB_Path, True
Set DB = Nothing
Set RS = Nothing
Set WKB = Nothing
'***************************************************
 
'Funding Report*************************************
strSQL = "qry_Kathleen_Rpt_RS"
Set DB = CurrentDb
Set RS = DB.OpenRecordset(strSQL)
 
strDB_Name = DB.Name
strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
WKB_Path = WKB_Path & "ExcelData\"
Set XLApp = New Excel.Application
Set WKB = XLApp.Workbooks.Open(WKB_Path)
strCaption = "WAH"
Funding RS, WKB, strCaption, WKB_Path, True
Set DB = Nothing
Set RS = Nothing
Set WKB = Nothing
 
 
'***************************************************
 
'Running Rate Report********************************
strSQL = "qry_RR_Rpt_RS"
Set DB = CurrentDb
Set RS = DB.OpenRecordset(strSQL)
 
strDB_Name = DB.Name
strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
 
WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
WKB_Path = WKB_Path & "ExcelData\"
 
Set XLApp = New Excel.Application
 
Set WKB = XLApp.Workbooks.Open(WKB_Path)
strCaption = "WAH"
 
Funding RS, WKB, strCaption, WKB_Path, True
'***************************************************
Set DB = Nothing
Set RS = Nothing
Set WKB = Nothing
End Sub
 

Here is an example of the code to print the data to a spreadsheet. The "writecelltext" or "writecellmoney" functions just format the data for printing to the spreadsheet:

Sub Funding(ByRef RS As DAO.Recordset, WKB As Workbook, strCaption As String, WKB_Path As String, ALL As Boolean)
 
Dim WKS As Worksheet
Dim lngRow As Long
Dim rrow As Integer:      rrow = 2
Dim actionFlag As String: actionFlag = ""
Dim strSaveAsPath As String
 
    Set WKS = WKB.Worksheets("Funding")
    'writeCellText wks, rrow - 2, 1, strCaption, actionFlag, "Center"
 
 
    While Not RS.EOF()
 
        writeCellText WKS, rrow, 1, RS!TO2, actionFlag, "LEFT" 'TO2 A
        writeCellText WKS, rrow, 2, RS!DCN, actionFlag, "LEFT" 'DCN B
        writeCellText WKS, rrow, 3, RS!Status, actionFlag, "LEFT" 'STATUS C
        writeCellText WKS, rrow, 4, RS!Active_Inactive, actionFlag, "LEFT" 'Active_Inactive D
        writeCellText WKS, rrow, 5, RS!Division, actionFlag, "LEFT" 'DIVISION E
        writeCellMoney WKS, rrow, 6, RS!Funds_Obligated, actionFlag 'Funds_Obligated F
        writeCellMoney WKS, rrow, 7, RS!Total_Final_Invoiced, actionFlag 'Total_Final_Invoiced G
        writeCellMoney WKS, rrow, 8, RS!Funds_Rem, actionFlag 'Funds_Rem H
        writeCellPercent WKS, rrow, 9, RS!Percent_Spent, actionFlag 'Percent_Spent I
        writeCellPercent WKS, rrow, 10, RS!Percent_Rem, actionFlag 'Percent_Rem J
 
        rrow = rrow + 1
        RS.MoveNext
    Wend
    '*****************************************************
 
    WKS.PageSetup.LeftMargin = 0.5
    WKS.PageSetup.RightMargin = 0.5
    WKS.PageSetup.TopMargin = 0.75
    WKS.PageSetup.BottomMargin = 0.5
 
    WKS.PageSetup.Orientation = xlLandscape
    WKS.PageSetup.PrintArea = "$A$1:$L$" & CStr(rrow + 1)
    'New code**************************
    WKS.PageSetup.Zoom = False
    WKS.PageSetup.FitToPagesWide = 1
    WKS.PageSetup.FitToPagesTall = 100
    '**********************************
 
    strSaveAsPath = WKB_Path
    strSaveAsPath = Left(strSaveAsPath, InStrRev(strSaveAsPath, "\"))
    strSaveAsPath = strSaveAsPath & "Funding_" & Format(Date, "mm-dd-yy") & "_" & Format(Time, "HH-MM") & ".xlsx"
 
    If ALL = False Then
        WKB.SaveCopyAs strSaveAsPath
        OpenExcel strSaveAsPath
        WKB.Close SaveChanges:=False
    End If
 
 
'    Set WKB = Nothing
'    Set RS = Nothing
'    Set WKS = Nothing
 
End Sub
 

Please help. I need to generate each RS to a the same workbook on separate sheets. Thank you in advance for advice.

[twinnyfo]

BikeToWorkHome,

I think what you are asking is very possible, and I don't think too complex. I think one of the issues is that you keep instantiating a "New" Excel Applicaiton (Lines 45, 68). Instead of a New Excel Applicaiton, try using

ActiveWorkbook.Sheets.Add()

Additionally, rather than writing each line individually, which can take a long time if you have many records, you can declare a Range, and then use .CopyFromRecordset and place the results of the entire query into the SpreadSheet. Then, select the columns you need formatted differently and apply it after the fact.

I can provide additional details if needed, but at this point, I assume some general knowledge of VBA/automating Excel.

Also, not sure if OP and Post #3 are from the same person?

[NeoPa]

If you're doing this within Access Automation of Excel then one of the gotchas is that ActiveWorkbook won't work. The full reference in Excel is Application.ActiveWorkbook. In Excel the Application part is defaulted, but in Access it won't be. You'd need to specify it as a property of whatever variable you use to store your Excel Application object

[twinnyfo]

Thanks for the clarification. I had also made some assumptions...

;-)

[NeoPa]

TwinnyFo:
Also, not sure if OP and Post #3 are from the same person?

I certainly hope so. BikeToWork is a long-time member and a recognised name. If anyone else were attempting to steal their identity that may be seen as a problem. As it happens, the email addresses used for the two accounts are similar enough to indicate the same person.

@BtW.
Perhaps you could PM me with your reasons for creating a separate account. We actually have a rule here that prohibits that - but that's for reasons that don't really apply to you. I'd be interested in knowing your reasons and could look into merging them into a single account if you wished.

NB. Please only reply as a PM to me.

[BikeToWorkHome]

Twinnyfo, BikeToWorkHome and BikeToWork are both me. I just created a new BikeToWorkHome account since I am at home and don't have the Bytes pwd from work. Thanks for your help. I already have a workbook created with formatted worksheets, one for each rs, where the data goes. If I print the worksheets one at a time, it works fine. When I try to print all three together it fails. I just need to transfer 3 Access recordsets to the same workbook on three separate worksheets in the workbook. I don't really need to add sheets since there are already existing sheets in the workbook. I don't really need to add sheets, but I can see where creating the Excel.Application three times is a problem. If you could give me some simple example of exporting three Access recordsets to the same workbook on three existing spreadsheets in that workbook I can probably figure it out from there. Thanks again. NeoPa?

[twinnyfo]

Too easy!

Dim wsSheet As Excel.Worksheet
 
Set wsSheet = WKB.Sheets("YourWorksheetName")
wsSheet.Activate
wsSheet.Cells(1,1) = "Hello BikeToWorkHome!"

Of course, assuming this is tied into all your other code.

[twinnyfo]

I should also add some comments about the .CopyFromRecordset method I mentioned.

The trick is several fold, but easy to work through.

1. First, you need to make sure you know exactly how large your recordset is, in rows and columns (Headings don't count).

2. Then you need to make sure your Recordset has been moved to the first record.

3. Then using a Range, you declare the size of the range that fits your recordset and use the .CopyFromRecordset method.

So, if you want to place the contents of a recordset starting in Row 2 (I presume you already have column headings) and Column A, your code would look like this:

Private Sub ExcelSample()
On Error GoTo EH
    Dim db      As DAO.Database
    Dim rst     As DAO.Recordset
    Dim intRows As Integer
    Dim intCols As Integer
    Dim xlApp   As Excel.Application
    Dim wbBook  As Excel.Workbook
    Dim wsSheet As Excel.Worksheet
 
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("tblYourTable")
    With rst
        If Not .RecordCount = 0 Then
            .MoveLast
            intRows = .RecordCount
            .MoveFirst
            intCols = .Fields.Count
            Set xlApp = New Excel.Application
            Set wbBook = xlApp.Workbooks.Open("Your XL File")
            Set wsSheet = wbBook.Sheets("Your Sheet Name")
            wsSheet.Activate
            With xlSheet
                .Range(.Cells(2, 1), _
                .Cells(intRows + 1, intCols)).CopyFromRecordset _
                rst
            End With
            'Save and close your spreadsheet.....
        End If
        .Close
    End With
    db.Close
    Set rst = Nothing
    Set db = Nothing
 
    Exit Sub
EH:
    MsgBox "There was an error with the sample!  " & _
        "Please contact your Database Administrator.", vbCritical, "WARNING!"
    Exit Sub
End Sub

I haven't tested this particular code, but have identical code in my DBs that works like a charm.

Concerning formatting cells, if you did not know about this, you can select a range (even an entire column) and then use
.Selection.NumberFormat = "dd-mmm-yy" (or whatever format you choose).

Hope this hepps!

[NeoPa]

BikeToWorkHome:
NeoPa?

That's really not an easy question to answer.

If my previous post wasn't clear then please send me a PM (Private Message) explaining the situation with the two accounts. They're not really allowed but if you have a good reason for requiring two then we can consider that. An option that was offered was to consider if it's possible to remove the latter after merging it into the former.