Coding a cmd button to output each record to a seperate sheet within a workbook

[Clete]

Private Sub cmdPrintChecks_Click()

Dim ExcelApp As Excel.Application
Dim ExcelWorkbook As Excel.Workbook
Dim ExcelSheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sPath As String
Dim i As Integer

Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Add
Set db = CurrentDb
Set rs = db.OpenRecordset("tmpCheckQueue")



sPath = "C:\Checks"

rs.MoveFirst

i = 1

Do Until rs.EOF

Set ExcelSheet = ExcelWorkbook.Worksheets(i)




rs.MoveNext
i = i + 1
Loop

rs.Close
Set rs = Nothing
Set db = Nothing
Set ExcelApp = Nothing
Set ExcelWorkbook = Nothing
Set ExcelSheet = Nothing



End Sub

 

[Clete]

Im extremely stuck. I found some code and wrote the shell of what im trying to do posted above. In the Do Until part I need to fill it in. Let's say I have 2 records in the table called tmpCheckQueue with the fields Amount and CheckNo. How do I code the loop to place Amount into A1 and CheckNo into B1 from the first record into Sheet1 and then do the same for record 2 into Sheet2. I know once I can get this part to work I have everything Ill need to finish and ive been trying hard find examples, I think this situation is a bit rare. Thanks for all the help it's greatly appreciated.

 

[Trevor G]

I would take the approach of initially using a DoCmd.TransferSpreadsheet to get the data into a workbook you can then use VBA to separate the data onto separate sheets. See example

Sub transferData()
'Click Tools Menu --> References --> Search down
'Set References to Excel XX Object Library
'Transfer Query
DoCmd.TransferSpreadsheet acExport, 10, "qryITDept", "c:\Access\exp2.xlsx", True, ""
'Create Excel Application
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
'Open the workbook
With xlApp
.workbooks.Open ("c:\Access\exp2.xlsx")
'Add 2 extra sheets
.Sheets.Add
.Sheets.Add
'Select named sheet
.Sheets("qryITDept").Select
'Make excel visible
.Visible = True
End With
End Sub

 

[Micron]

You can get the values you need by rs.fields where n in the field number (0 based) and entering it into the worksheet cell, then looping back to get the value from the next field. Something like this below is dynamic in that it will work for however many columns you need to write to. Don't forget to dim these added variables. xlc is my range object, cellStart is the starting position that is pulled from a table of parameters in case worksheet design alters the starting position.

Set xlc = xlc.Offset(0, 0) 'if headers not written, no offset from cellStart
' write data to worksheet
Do While Not rst.EOF
For lngColumn = 0 To rst.Fields.count - 1
xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop

 

[Clete]

Thanks for the replies I finished the program it's basically a program to print checks by passing fields from each check record into separate excel sheets..... Here is the code. I haven't added the line to print the entire workbook anybody know what that is? Thanks.

Private Sub cmdPrintChecks_Click()

Dim ExcelApp As Excel.Application
Dim ExcelWorkbook As Excel.Workbook
Dim ExcelSheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sPath As String
Dim i As Integer
Dim ShortDateFmt As String


Set ExcelApp = CreateObject("Excel.Application")
Set ExcelWorkbook = ExcelApp.Workbooks.Add
Set db = CurrentDb
Set rs = db.OpenRecordset("tmpCheckQueue")

'sPath = "C:\Checks2"

rs.MoveFirst

i = 0

Do Until rs.EOF

i = i + 1
Set ExcelSheet = ExcelWorkbook.Worksheets(i)
ExcelSheet.Rows(1).RowHeight = 28
ExcelSheet.Rows(2).RowHeight = 18
ExcelSheet.Rows(3).RowHeight = 18
ExcelSheet.Rows(4).RowHeight = 18
ExcelSheet.Rows(5).RowHeight = 27
ExcelSheet.Rows(6).RowHeight = 27
ShortDateFmt = Format(Date, "Short Date")
ExcelSheet.Range("d2").Value = ShortDateFmt
ExcelSheet.Range("a7").Value = "File No. :"
ExcelSheet.Range("a8").Value = "Creditor :"
ExcelSheet.Range("a9").Value = "Debtor :"
ExcelSheet.Range("c7").Value = "Payment Amount :"
ExcelSheet.Range("c8").Value = "Fees :"
ExcelSheet.Range("c9").Value = "Fees 2 :"
ExcelSheet.Range("c10").Value = "Check Herewith :"
ExcelSheet.Range("c11").Value = "Leaving a balance of:"
ExcelSheet.Range("d2") = rs(1)
ExcelSheet.Range("d3").NumberFormat = "$#,##0.00"
ExcelSheet.Range("d3") = rs(2)
ExcelSheet.Range("b4") = rs(3)
ExcelSheet.Range("b5") = rs(4)
ExcelSheet.Range("b7") = rs(5)
ExcelSheet.Range("b7").HorizontalAlignment = xlLeft
ExcelSheet.Range("b8") = rs(6)
ExcelSheet.Range("d7:d11").NumberFormat = "$* #,##0.00"
ExcelSheet.Range("b9") = rs(7)
ExcelSheet.Range("d7") = rs(8)
ExcelSheet.Range("d8") = rs(9)
ExcelSheet.Range("d9") = rs(10)
ExcelSheet.Range("d10") = rs(11)
ExcelSheet.Range("d11") = rs(12)
ExcelSheet.Columns(1).ColumnWidth = 9
ExcelSheet.Columns(2).ColumnWidth = 36
ExcelSheet.Columns(3).ColumnWidth = 18
ExcelSheet.Columns(4).ColumnWidth = 13.5


rs.MoveNext

Loop

ExcelWorkbook.SaveAs "C:\Checks99.xls"
ExcelWorkbook.Close
ExcelApp.Quit

rs.Close
Set rs = Nothing
Set db = Nothing
Set ExcelApp = Nothing
Set ExcelWorkbook = Nothing
Set ExcelSheet = Nothing



End Sub

 

[Micron]

Impressive!
try
YourWorkbookObjName.PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName, IgnorePrintAreas)
I think you can omit any of the parameters, but leading or nested ones would require single commas for each