Export Filtered Form Data to Excel (1 Viewer)

ZeidHaddad

Registered User.
Local time
Yesterday, 22:01
Joined
Oct 29, 2019
Messages
44
Hello Everyone! i was looking for a way to export my data from a Specific Form to excel and i used the code above but unfortunately on the click event only the excel sheet opens without exporting anything with a message "index out of range" something like this.

here is the information needed:
Form Name: TestFrm
Function; Send to excel

Private Sub Befehl239_Click()
Call Send2Excel(Forms!TESTFRM, "strSheetExport")
End Sub

Public Function Send2Excel(TESTFRM As Form, Optional strSheetExport As String)

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 = TESTFRM.RecordsetClone
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetExport) > 0 Then
xlWSh.Name = Left(strSheetExport, 34)
End If
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
pXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
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
ApXL.ActiveSheet.Cells.Select
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
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
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:01
Joined
Oct 29, 2018
Messages
21,454
Hi. Which line is getting highlighted when you go to debug? Have you tried stepping through your code? You might want to verify you're getting a recordset first before creating the Excel file.
 

ZeidHaddad

Registered User.
Local time
Yesterday, 22:01
Joined
Oct 29, 2019
Messages
44
DB guy for the rescue :D

this line pXL.ActiveCell = fld.Name

and not really sure how to do the second part
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:01
Joined
Oct 29, 2018
Messages
21,454
DB guy for the rescue :D

this line pXL.ActiveCell = fld.Name

and not really sure how to do the second part
So, that sounds like maybe either pXL.ActiveCell or fld.Name doesn't exist. It's probably more likely that the recordset is not set. For example, try inserting the following line:
Code:
...
On Error GoTo err_handler
Set rst = TESTFRM.RecordsetClone
[B]MsgBox rst Is Nothing[/B]
Set ApXL = CreateObject("Excel.Application")
...
If you get True, then you don't have a recordset.
 

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 22:01
Joined
Oct 29, 2018
Messages
21,454
i got false
Hmm, then maybe check the Excel variable next. Something like:
MsgBox ApXL Is Nothing

But wait... I just noticed, is that a typo?

pXL.ActiveCell = fld.Name

Isn't that supposed to be?

ApXL.ActiveCell = fld.Name


PS. Either that or ApXL doesn't have an ActiveCell property. Or maybe it's incomplete. For example: ActiveCell.Name
 

andreap

New member
Local time
Today, 07:01
Joined
Feb 20, 2020
Messages
1
My form's name is "Vendor Listing beta - CombinedV2" and my command button is: "cmdExport." The function name is "Send2Excel"

The code I have to call the Function on the OnClick event of the button is: Call Send2Excel(Forms!"Vendor Listing beta - CombinedV2", "strSheetExport").

Public Function Send2Excel(frm"Vendor Listing beta - CombinedV2" As Form, Optional strSheetExport 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 fld As DAO.Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
' On Error GoTo err_handler
Set rst = "Vendor Listing beta - CombinedV2".RecordsetClone
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetExport) > 0 Then
xlWSh.Name = Left(strSheetExport, 34)
End If
xlWSh.Activate
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
' This is included to show some of what you can do about formatting.
' You can comment out or delete
' any of this below 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

Thank you very much!
I've a question. How to chose a personalized name of the column in excel?
 

Users who are viewing this thread

Top Bottom