Solved Error sending report to Excel (1 Viewer)

Krayna

Member
Local time
Today, 14:09
Joined
Sep 24, 2020
Messages
380
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:
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
 

Ranman256

Well-known member
Local time
Today, 09:09
Joined
Apr 9, 2015
Messages
3,890
have you tried using : docmd.transferspreadsheet,
then open it and do the formatting?
 

arnelgp

once i caught a fish alive...
Local time
Today, 21:09
Joined
May 7, 2009
Messages
13,236
put a Breakpoint (press F9) on the function.
Step (F8) through each code 1 line by line, hovering on each variable
to see if there is any anomaly you can discover.
 

Krayna

Member
Local time
Today, 14:09
Joined
Sep 24, 2020
Messages
380
Tried different function and works better. Too much hard-coding here...
 

Users who are viewing this thread

Top Bottom