By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
426,247 Members | 1,989 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 426,247 IT Pros & Developers. It's quick & easy.

Open Excel One Workbook Multiple Sheets from MS Access

100+
P: 124
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.
Mar 20 '18 #1
Share this Question
Share on Google+
11 Replies


NeoPa
Expert Mod 15k+
P: 31,419
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.
Mar 21 '18 #2

twinnyfo
Expert Mod 2.5K+
P: 3,212
Or, in case you did not know that this existed, there is this basic code to add a worksheet to Excel:

Expand|Select|Wrap|Line Numbers
  1. 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.
Mar 21 '18 #3

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

Expand|Select|Wrap|Line Numbers
  1. Private Sub cmdAllReportsExcel_Click()
  2. Dim RS As DAO.Recordset
  3. Dim strSQL As String
  4. Dim strPath As String
  5. Dim strDB_Name As String
  6. Dim strExcelPath As String
  7. Dim strCaption As String
  8. Dim WKB_Path As String
  9. Dim DB As DAO.Database
  10. Set DB = CurrentDb
  11. Dim WKB As Excel.Workbook
  12. Dim XLApp As Excel.Application
  13.  
  14. 'Six Block Report**********************************
  15. strSQL = "qry_6Block_RPT_RS"
  16. Set RS = DB.OpenRecordset(strSQL)
  17. strDB_Name = DB.Name
  18. strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  19. strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
  20.  
  21. WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  22. WKB_Path = WKB_Path & "ExcelData\"
  23. Set XLApp = New Excel.Application
  24.  
  25. Set WKB = XLApp.Workbooks.Add(strExcelPath)
  26. strCaption = "WAH"
  27.  
  28. '6 Block Report*************************************
  29. SixBlockReport RS, WKB, strCaption, WKB_Path, True
  30. Set DB = Nothing
  31. Set RS = Nothing
  32. Set WKB = Nothing
  33. '***************************************************
  34.  
  35. 'Funding Report*************************************
  36. strSQL = "qry_Kathleen_Rpt_RS"
  37. Set DB = CurrentDb
  38. Set RS = DB.OpenRecordset(strSQL)
  39.  
  40. strDB_Name = DB.Name
  41. strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  42. strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
  43. WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  44. WKB_Path = WKB_Path & "ExcelData\"
  45. Set XLApp = New Excel.Application
  46. Set WKB = XLApp.Workbooks.Open(WKB_Path)
  47. strCaption = "WAH"
  48. Funding RS, WKB, strCaption, WKB_Path, True
  49. Set DB = Nothing
  50. Set RS = Nothing
  51. Set WKB = Nothing
  52.  
  53. '***************************************************
  54.  
  55. 'Running Rate Report********************************
  56. strSQL = "qry_RR_Rpt_RS"
  57. Set DB = CurrentDb
  58. Set RS = DB.OpenRecordset(strSQL)
  59.  
  60. strDB_Name = DB.Name
  61. strDB_Name = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  62. strExcelPath = strDB_Name & "ExcelTemplate\Funding.xlsx"
  63.  
  64. WKB_Path = Left(strDB_Name, InStrRev(strDB_Name, "\"))
  65. WKB_Path = WKB_Path & "ExcelData\"
  66.  
  67. Set XLApp = New Excel.Application
  68.  
  69. Set WKB = XLApp.Workbooks.Open(WKB_Path)
  70. strCaption = "WAH"
  71.  
  72. Funding RS, WKB, strCaption, WKB_Path, True
  73. '***************************************************
  74. Set DB = Nothing
  75. Set RS = Nothing
  76. Set WKB = Nothing
  77. End Sub
  78.  
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:

Expand|Select|Wrap|Line Numbers
  1. Sub Funding(ByRef RS As DAO.Recordset, WKB As Workbook, strCaption As String, WKB_Path As String, ALL As Boolean)
  2.  
  3. Dim WKS As Worksheet
  4. Dim lngRow As Long
  5. Dim rrow As Integer:      rrow = 2
  6. Dim actionFlag As String: actionFlag = ""
  7. Dim strSaveAsPath As String
  8.  
  9.     Set WKS = WKB.Worksheets("Funding")
  10.     'writeCellText wks, rrow - 2, 1, strCaption, actionFlag, "Center"
  11.  
  12.  
  13.     While Not RS.EOF()
  14.  
  15.         writeCellText WKS, rrow, 1, RS!TO2, actionFlag, "LEFT" 'TO2 A
  16.         writeCellText WKS, rrow, 2, RS!DCN, actionFlag, "LEFT" 'DCN B
  17.         writeCellText WKS, rrow, 3, RS!Status, actionFlag, "LEFT" 'STATUS C
  18.         writeCellText WKS, rrow, 4, RS!Active_Inactive, actionFlag, "LEFT" 'Active_Inactive D
  19.         writeCellText WKS, rrow, 5, RS!Division, actionFlag, "LEFT" 'DIVISION E
  20.         writeCellMoney WKS, rrow, 6, RS!Funds_Obligated, actionFlag 'Funds_Obligated F
  21.         writeCellMoney WKS, rrow, 7, RS!Total_Final_Invoiced, actionFlag 'Total_Final_Invoiced G
  22.         writeCellMoney WKS, rrow, 8, RS!Funds_Rem, actionFlag 'Funds_Rem H
  23.         writeCellPercent WKS, rrow, 9, RS!Percent_Spent, actionFlag 'Percent_Spent I
  24.         writeCellPercent WKS, rrow, 10, RS!Percent_Rem, actionFlag 'Percent_Rem J
  25.  
  26.         rrow = rrow + 1
  27.         RS.MoveNext
  28.     Wend
  29.     '*****************************************************
  30.  
  31.     WKS.PageSetup.LeftMargin = 0.5
  32.     WKS.PageSetup.RightMargin = 0.5
  33.     WKS.PageSetup.TopMargin = 0.75
  34.     WKS.PageSetup.BottomMargin = 0.5
  35.  
  36.     WKS.PageSetup.Orientation = xlLandscape
  37.     WKS.PageSetup.PrintArea = "$A$1:$L$" & CStr(rrow + 1)
  38.     'New code**************************
  39.     WKS.PageSetup.Zoom = False
  40.     WKS.PageSetup.FitToPagesWide = 1
  41.     WKS.PageSetup.FitToPagesTall = 100
  42.     '**********************************
  43.  
  44.     strSaveAsPath = WKB_Path
  45.     strSaveAsPath = Left(strSaveAsPath, InStrRev(strSaveAsPath, "\"))
  46.     strSaveAsPath = strSaveAsPath & "Funding_" & Format(Date, "mm-dd-yy") & "_" & Format(Time, "HH-MM") & ".xlsx"
  47.  
  48.     If ALL = False Then
  49.         WKB.SaveCopyAs strSaveAsPath
  50.         OpenExcel strSaveAsPath
  51.         WKB.Close SaveChanges:=False
  52.     End If
  53.  
  54.  
  55. '    Set WKB = Nothing
  56. '    Set RS = Nothing
  57. '    Set WKS = Nothing
  58.  
  59. End Sub
  60.  
Please help. I need to generate each RS to a the same workbook on separate sheets. Thank you in advance for advice.
Mar 21 '18 #4

twinnyfo
Expert Mod 2.5K+
P: 3,212
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
Expand|Select|Wrap|Line Numbers
  1. 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?
Mar 21 '18 #5

NeoPa
Expert Mod 15k+
P: 31,419
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
Mar 21 '18 #6

twinnyfo
Expert Mod 2.5K+
P: 3,212
Thanks for the clarification. I had also made some assumptions...

;-)
Mar 21 '18 #7

NeoPa
Expert Mod 15k+
P: 31,419
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.
Mar 21 '18 #8

P: 2
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?
Mar 21 '18 #9

twinnyfo
Expert Mod 2.5K+
P: 3,212
Too easy!

Expand|Select|Wrap|Line Numbers
  1. Dim wsSheet As Excel.Worksheet
  2.  
  3. Set wsSheet = WKB.Sheets("YourWorksheetName")
  4. wsSheet.Activate
  5. wsSheet.Cells(1,1) = "Hello BikeToWorkHome!"
Of course, assuming this is tied into all your other code.
Mar 21 '18 #10

twinnyfo
Expert Mod 2.5K+
P: 3,212
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:

Expand|Select|Wrap|Line Numbers
  1. Private Sub ExcelSample()
  2. On Error GoTo EH
  3.     Dim db      As DAO.Database
  4.     Dim rst     As DAO.Recordset
  5.     Dim intRows As Integer
  6.     Dim intCols As Integer
  7.     Dim xlApp   As Excel.Application
  8.     Dim wbBook  As Excel.Workbook
  9.     Dim wsSheet As Excel.Worksheet
  10.  
  11.     Set db = CurrentDb()
  12.     Set rst = db.OpenRecordset("tblYourTable")
  13.     With rst
  14.         If Not .RecordCount = 0 Then
  15.             .MoveLast
  16.             intRows = .RecordCount
  17.             .MoveFirst
  18.             intCols = .Fields.Count
  19.             Set xlApp = New Excel.Application
  20.             Set wbBook = xlApp.Workbooks.Open("Your XL File")
  21.             Set wsSheet = wbBook.Sheets("Your Sheet Name")
  22.             wsSheet.Activate
  23.             With xlSheet
  24.                 .Range(.Cells(2, 1), _
  25.                 .Cells(intRows + 1, intCols)).CopyFromRecordset _
  26.                 rst
  27.             End With
  28.             'Save and close your spreadsheet.....
  29.         End If
  30.         .Close
  31.     End With
  32.     db.Close
  33.     Set rst = Nothing
  34.     Set db = Nothing
  35.  
  36.     Exit Sub
  37. EH:
  38.     MsgBox "There was an error with the sample!  " & _
  39.         "Please contact your Database Administrator.", vbCritical, "WARNING!"
  40.     Exit Sub
  41. 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!
Mar 21 '18 #11

NeoPa
Expert Mod 15k+
P: 31,419
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.
Mar 21 '18 #12

Post your reply

Sign in to post your reply or Sign up for a free account.