Exporting Query to Excel Spreadsheet

[sharifb18]

Hi All I am trying to export a query to an pre-existing spreadsheet. I am new to VBA and when I implement the following code nothing happened. Please let me know what I am doing wrong Thanks!

Option Compare Database

Public Function Sheet(strTQName As String, strSheetName As String)

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = CurrentDb.OpenRecordset("Select * From ChequeRequest")

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open("P:\2014Payments.xlsx")
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets(Sheet_1)

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

With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = 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

Sub ChequeRequest()

End Sub

 

[The_Doc_Man]

First, you are working too hard.

Make a query using the design window.

Then open that query and assure that it looks like you wanted it to look AS AN ACCESS QUERY.

Right click in the query, which brings up a drop-down box with an Export option, one part of which is the Export to Excel action. Alternatively, there is a menu option for external data that would allow you to find icons for exporting queries.

The pitfall is if the query has wildly variable cell contents but the wild variations don't occur within the first 20 rows or so, you might get formatting errors.

The good news is that query methods exist to do exports in VBA, so once you get it set up correctly, you can do the export from code - but it will be a LOT faster.

One way that has supposedly worked at blocking the problem of formatting errors is that you pre-design the Excel workbook with the worksheet having pre-formatted columns. Then use the File System object to copy the prototype workbook to another file and do the export to the copy of the pre-formatted prototype.

 

[sharifb18]

Thanks for the advice The_Doc_Man. Just want to add that I do regular exports from access to excel and as a result I use a form to automate the transfer into excel. I want to be at the point where I can just click on a button and transfer the spreadsheet. Would transferspreadsheet.cmd work better?

 

[sharifb18]

Anyone else have suggestions?

 

[Frothingslosh]

DoCmd.Transferspreadsheet would be your best option.

 

[sharifb18]

I am trying to now connect my form to vba through a button. What I hope to do is click on a button and have the query transfered into a prexisting sheet on a prexisting workbook. However when I click on the button I get an error saying Too few parameters, Expected 9. does this have to do with my query or my vba code?

Option Compare Database
Private Sub Command85_Click()
Call SendTQ2ExcelSheet("ChequeRequest", "ChequeRequest", "C:\Users\Desktop\2014Payments.xlsx")
End Sub
Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String, strFilePath 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 send it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset(strTQName)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(strPath)
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets.AddNew

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("A1").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

' 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