export Access query to Excel 2

[hellohello1]

What is the code to export Access data to Excel if the query I want to send to Excel is a crosstab query that has 2 parameters? (The parameters are 2 values from two combo boxes on my form).
One parameter is called [Forms]![frmEscalationReports]![cboEscalation] and is a long integer.
The other parameter is called [Forms]![frmEscalationReports]![cboDate] and is a date.

I am trying to export to Excel with 2 special formatting needs in Excel:
--Data, Filter, AutoFilter is turned on for my columns in Row 1.
--My column names in Row 1 are turned vertically. In other words, the Orientation is 90 degrees. (Format, Cells, Alignment tab, Orientation section).

Thanks!!!

 

[hellohello1]

How did you know where I am?

The flowers are pretty, although the prime bloom season has passed.

What state are you in?

 

[SkipVought]

Texas.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

Cool.



I have a cousin in Austin and an aunt, uncle and cousin in Missouri City.

I bet it's hot there now!

 

[hellohello1]

Can I ask how you knew I was in DC since my profile doesn't mention that.

I don't mind, I'm just curious how you knew.

Thanks!

 

[hellohello1]

Skip,
Are you still there?

I am trying to use the same Send2Excel code to send a different query to Excel.

But this query has some Memo fields and I'm getting an error: "Method 'CopyFromRecordset' of Object 'Range' failed" when it comes to a record with a lot of text in the field. Hitting 'debug' highlights this line:

xlWSh.Range("A2").CopyFromRecordset rst

Here is my complete code:

'---------------------------------------------------------------------------------------
' Procedure : Send2Excel
' Author : Bob Larson
' Date : 5/25/2008
' Purpose : Send any single recordset form to Excel. This will not work with
' subforms.
' Use : You may freely use this code as long as the author information in
' this header remains intact
'---------------------------------------------------------------------------------------
Public Function Send2Excel(qry As String, Optional strSheetName As String)
' qry is the name of the query you want to send to Excel
' strSheetName is the optional 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 fld As Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

' On Error GoTo err_handler


Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set db = CurrentDb
Set qdf = db.QueryDefs(qry)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset

'check to see if there is data. If not, display a message and exit the function
If rst.RecordCount = 0 Then
MsgBox "Your report selection returned no data", , "No data"
Exit Function
End If


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

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select


For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select

' formatting for the first row (1:1)
With ApXL.Selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
End With

With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
End With

' selects all of the cells
ApXL.ActiveSheet.Cells.Select

' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

'set page to Landscape
ApXL.ActiveSheet.PageSetup.Orientation = 2

'make the column headers vertical (90 degrees)
xlWSh.Range("1:1").Select
ApXL.Selection.Orientation = 90

'add header (title) and footer (page numbers) and repeat title rows and make paper legal size.
ApXL.ActiveSheet.PageSetup.CenterHeader = "Escalation Report for " & Forms!frmEscalationReports!cboEscalation.Column(1)
ApXL.ActiveSheet.PageSetup.LeftFooter = "Page &P of &N"
ApXL.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ApXL.ActiveSheet.PageSetup.PaperSize = xlPaperLegal

'make Row 1 gray
With ApXL.Intersect(xlWSh.Range("A1").CurrentRegion, xlWSh.Rows(1))
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With

'adjusts the column size for column 2 and 3 and row height for row 1.
xlWSh.Columns("B:B").ColumnWidth = 22
xlWSh.Columns("C:C").ColumnWidth = 49
xlWSh.Rows("1:1").RowHeight = 73.5

'adds the autofilter to the first row
ApXL.Selection.AutoFilter

'add table border
With xlWSh.Range("A1").CurrentRegion
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

'set freeze panes
xlWSh.Rows("2:2").Select
ApXL.ActiveWindow.FreezePanes = True

'delete Sheet2 and Sheet3
xlWBk.Sheets(Array("Sheet2", "Sheet3")).Select
xlWBk.Sheets("Sheet3").Activate
ApXL.ActiveWindow.SelectedSheets.Delete

' 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


Can memo fields be exported to Excel?
Thanks

 

[mgrabows]

I love this code, but I'm having one problem with it.

'add header (title) and footer (page numbers) and repeat title rows and make paper legal size.
ApXL.ActiveSheet.PageSetup.CenterHeader = "Escalation Report for " & Forms!frmEscalationReports!cboEscalation.Column(1)
ApXL.ActiveSheet.PageSetup.LeftFooter = "Page &P of &N"
ApXL.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ApXL.ActiveSheet.PageSetup.PaperSize = xlPaperLegal

The final line that sets the paper size to Legal always fails for me (Access 2003 exporting to Excel 2007) saying "Unable to set papersize property".

Is there a fix for this?

 

[hellohello1]

mgrabows, did you set the reference as Skip mentions in his post above:


Skip's post:
"You probably do not have a reference set in Tools > References to a Microsoft Excel Object Library. So you cannot use Excel Constants like xlLandscape, or xlNone.So either add that reference, or open Excel and use the Object Browser to discover the numeric value for each Excel Constant. The latter is what I did to solve the page setup problem you were having."

 

[mgrabows]

Thanks for pointing me in the right direction. Sorry for the duplicate question!

I have another question and I was wondering if someone might point me in the right direction.

I have a query where autofit works for most fields. However, my last field (column) has Comment data and those lines can get pretty long. I'd like to set a static column width (so it fits on Legal paper) and allow the rows to grow based on their data.

Any pointers?

 

[mgrabows]

Figured it out.

Nothing advanced here, of course, but here's my code to wrap text on a column.

' Wraps text in Remarks column
With ApXL.Intersect(xlWSh.Range("A1").CurrentRegion, xlWSh.Columns(11))
.WrapText = True
End With