Export Filtered Form Data to Excel

[ZeidHaddad]

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

 

[ZeidHaddad]

Function name: Send2Excel

 

[theDBguy]

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]

DB guy for the rescue

this line pXL.ActiveCell = fld.Name

and not really sure how to do the second part

 

[theDBguy]

DB guy for the rescue

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:

...
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.

 

[ZeidHaddad]

i got false

 

[theDBguy]

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

 

[ZeidHaddad]

Solved! Thank you so much
helpful as always

 

[theDBguy]

Solved! Thank you so much
helpful as always

Congratulations! Glad to hear it worked for you. Good luck with your project.

 

[andreap]

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?