Kayleigh
Member
- Local time
- Today, 23:00
- Joined
- Sep 24, 2020
- Messages
- 709
Hi,
Have a report which is based on query. Would like to send it to Excel and using this code but when run, I just get error message that query doesn't exist and debugging it highlights: Set rst = CurrentDb.OpenRecordset(strTQName)
Definitely have query because it runs fine so how can I resolve this?
Code:
Have a report which is based on query. Would like to send it to Excel and using this code but when run, I just get error message that query doesn't exist and debugging it highlights: Set rst = CurrentDb.OpenRecordset(strTQName)
Definitely have query because it runs fine so how can I resolve this?
Code:
Code:
Public Function SendTQ2Excel(strTQName As String, Optional strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
'Dim objTable As Object
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
'On Error GoTo Err_Handler
Set rst = CurrentDb.OpenRecordset(strTQName)
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.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
If FieldTypeName(fld) = "Currency" Then
ApXL.ActiveCell.EntireColumn.NumberFormat = "$#,##0.00"
End If
ApXL.ActiveCell.Offset(0, 1).Select
NextIteration:
Next
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
'Set objTable = ActiveSheet.ListObjects.Add(, Selection, , xlYes)
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit Function