Display MULTIPLE tabs on EXCEL output from FORM

[taimysho0]

hello, i have a form with bounded textboxes. A user clicks a button and all the data in the textboxes are displayed in an excel spreadsheet. How would i make a second tab open up on that same spreadsheet that will display the results from a query? here is my code for the spreadsheet:



Public Function Send2Excel(frmqrychannelidsearch2 As Form, Optional hhfs As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to



Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = frmqrychannelidsearch2.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(hhfs) > 0 Then
xlWSh.Name = Left(hhfs, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function



I would then call this function by:

Send2Excel Me, "hhfs"

[Rawb]

The line

Set xlWSh = xlWBk.Worksheets("Sheet1")

Is where you set the Sheet you want to create/write data to. If you want to create a second sheet, you should be able to do it like so:

Dim xlWSh2 As Object

Set xlWSh2 = xlWBk.Worksheets("Sheet2")

Then you can just reference xlWSh2 for anything you want to show up on the second sheet.

[taimysho0]

thanks for the help, i copied the code for xlwsh and pasted it under but replaced everything that says xlwsh with xlwsh2 (i already declared it) but how would i get it to refer to my query? which part of the coding would i insert my query is what im trying to say.. heres what i have, i know it probably is wrong though

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlwsh As Object
Dim xlwsh2 As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = frmqrydaterequested2.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlwsh = xlWBk.Worksheets("Sheet1")
If Len(hhfs) > 0 Then
xlwsh.Name = Left(hhfs, 34)
End If
xlwsh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlwsh.Range("A2").CopyFromRecordset rst
xlwsh.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlwsh.Range("A1").Select

rst.Close
Set rst = Nothing


'Tais stuff

Set xlwsh2 = xlWBk.Worksheets("Sheet2")
If Len(hhfs) > 0 Then
xlwsh2.Name = Left(hhfs, 34)
End If
xlwsh2.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlwsh2.Range("A2").CopyFromRecordset rst
xlwsh2.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlwsh2.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function

[Rawb]

Ah.

That's done with the .CopyFromRecordset Object Method.

xlwsh2.Range("A2").CopyFromRecordset rst

Just create a Recordset with the data you want and use it instead of your rst recordset. For example, if you had a second Query loaded into a variable named rst2, you'd use the following:

xlwsh2.Range("A2").CopyFromRecordset rst2

[taimysho0]

hello, thanks for the help! i have a form that is bounded to my query so the results of the query display on that form. therefore, instead of declaring the query, i just declared the bounded form the results appear on. This is my coding below, however the code opens up 2 seperate excel spreadsheets. ( i declared 2 seperate functions and called both functions on the click event) the 2nd spreadhseet does not display any data however..


Public Function Send2Excel(frmqrychannelidsearch2 As Form, Optional hhfs As String)

' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to



Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim rst2 As DAO.Recordset
Dim xlwsh2 As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = frmqrychannelidsearch2.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(hhfs) > 0 Then
xlWSh.Name = Left(hhfs, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function

'tais
Public Function Send2Excel2(frmday4report As Form, Optional hhfs2 As String)

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim rst2 As DAO.Recordset
Dim xlwsh2 As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler
Set rst2 = frmday4report.RecordsetClone


Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlwsh2 = xlWBk.Worksheets("Sheet2")
If Len(hhfs2) > 0 Then
xlwsh2.Name = Left(hhfs2, 34)
End If
xlwsh2.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst2.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst2.MoveFirst
xlwsh2.Range("A2").CopyFromRecordset rst2
xlwsh2.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlwsh2.Range("A1").Select

rst2.Close
Set rst2 = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function

[taimysho0]

i also tried declaring the query, but im having some trouble with it, do i need to delcare it in the Public area where i delcare the function? also when declaring a query as a variable, what is the proper way to declare it? object?

i tried incorporating it into my code with rst2= = ("qryDay4Report")
and xlwsh2 as Set xlwsh2 = xlWBk.Worksheets("Sheet2")

here is another version of the code with these changes:


Public Function Send2Excel(frmqrychannelidsearch2 As Form, Optional hhfs As String)

' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to



Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim rst2 As Object
Dim xlwsh2 As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler
Set rst2 = ("qryDay4Report")
Set rst = frmqrychannelidsearch2.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
Set xlwsh2 = xlWBk.Worksheets("Sheet2")
If Len(hhfs) > 0 Then
xlWSh.Name = Left(hhfs, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
xlwsh2.Range("A2").CopyFromRecordset rst2
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function

[Rawb]

Honestly, the only problem I see with your code is that you don't initialize your variable intCount.

Find the line that says:

Do Until intCount = rst.Fields.Count

And add this just before it:

intCount = 0

If you do this for both functions, it should solve your problem.

As for your question on the Query, there are several ways to do it. Access has an actual Query Object that you can use but the easiest way is to jump straight to a Recordset with it.

Option 1 - Using QueryDefs (not recommended):

  Dim qdf As DAO.QueryDef
  Dim rst As DAO.Recordset

  ' Save your Access Query Object to a QueryDefs variable!
  Set qdf = CurrentDb().QueryDefs("myQuery")

  ' Now dump the results of your saved query into a Recordset.
  Set rst = CurrentDb().OpenRecordset(qdf.SQL, dbOpenSnapshot)

  ' Your code goes here

  ' Close our our variables
  qdf.Close
  rst.Close

  Set qdf = Nothing
  Set rst = Nothing

Option 2 - Using Recordsets (recommended):

  Dim rst As DAO.Recordset

  ' ONLY USE ONE OF THE FOLLOWING TWO LINES - THEY BOTH DO THE SAME THING
  ' Using a saved Query.
  Set rst = CurrentDb().OpenRecordset("myQuery", dbOpenSnapshot)

  ' Using straight SQL code.
  Set rst = CurrentDb().OpenRecordset("SELECT * FROM myTable WHERE myField=1", dbOpenSnapshot)

  ' Your code goes here

  ' Close our our variables
  rst.Close

  Set rst = Nothing

Obviously I recommend using the second method since you will still need to use a Recordset at some point in your code.

[taimysho0]

thanks for the help!

i put this in, but it gave me an error message "subscript out of range". the excel spreadsheet opens up, as well as a second spreadsheet, the computer thinks for a little bit as if is trying to process something before opening up the 2nd spreadsheet this time..

im thinking maybe the error has to do with when im calling the function. i have:

Send2Excel Me, "hhfs"
Send2Excel2 Me, "hhfs2"

if im calling a function for a query not bounded or on the current form, would i still need to use "Me"? for the 2nd function?

here is my current code now:
Public Function Send2Excel(frmqrydaterequested2 As Form, Optional HHFs As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to



Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = frmqrydaterequested2.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(HHFs) > 0 Then
xlWSh.Name = Left(HHFs, 34)
End If
xlWSh.Range("A1").Select
intCount = 0
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function
'tais
Public Function Send2Excel2(frmDay4Report As Form, Optional hhfs2 As String)

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim rst2 As DAO.Recordset
Dim xlwsh2 As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler
Set rst2 = CurrentDb().OpenRecordset("qryDay4Report", dbOpenSnapshot)


Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlwsh2 = xlWBk.Worksheets("Sheet2")
If Len(hhfs2) > 0 Then
xlwsh2.Name = Left(hhfs2, 34)
End If
xlwsh2.Range("A1").Select
intCount = 0
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst2.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst2.MoveFirst
xlwsh2.Range("A2").CopyFromRecordset rst2
xlwsh2.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlwsh2.Range("A1").Select

rst2.Close
Set rst2 = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.description, vbExclamation, Err.number
Exit Function

End Function

[taimysho0]

also, i tried using option 1, with the same result and error message.