Private Sub cmdQUERY2_Click()
Call Send2Excel(Forms!VendorListing, "VendorList")
End Sub
Public Function Send2Excel(VendorListing As Form, Optional VendorList 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 queryString As String
Dim ctrl As Control
Dim fld As DAO.Field
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
For Each fld In rst.Fields
For Each ctrl In Me.Controls
If ctrl.ControlType = 109 Then
If fld.SourceField = ctrl.ControlSource Then
If Not ctrl.ColumnHidden Then
queryString = queryString & fld.SourceField & ","
Set rst = VendorListing.RecordsetClone
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(VendorList) > 0 Then
xlWSh.Name = Left(VendorList, 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 = "Calibri" 'Font
.Size = 11 'Font Size
.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
queryString = Left(queryString, Len(queryString) - 1)
End Function