|
Manufacturing Information Solutions Your Place for Support and Discussions
|
View previous topic :: View next topic |
Author |
Message |
mistux Site Admin
Joined: 25 Jun 2004 Posts: 1042 Location: South Bend, Indiana USA
|
Posted: Mon Sep 22, 2014 3:55 pm Post subject: Export Query to Excel |
|
|
Here is some code to export a query to an excel spreadsheet:
Code: |
On Error GoTo Error_Handler
Dim strWorksheetPath As String
strWorksheetPath = "C:\Temp\"
strWorksheetPath = strWorksheetPath & "ProjectReport " & Format(Date, "mmddyyyy") & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryProjectReport", strWorksheetPath, True
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: btnExportReport_Click" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
|
|
|
Back to top |
|
|
mistux Site Admin
Joined: 25 Jun 2004 Posts: 1042 Location: South Bend, Indiana USA
|
Posted: Mon Sep 22, 2014 3:56 pm Post subject: |
|
|
Export A Table Or Query To Excel
COPY THIS CODE INTO A STANDARD (not form or report) MODULE. NAME THE MODULE SOMETHING OTHER THAN THIS FUNCTION NAME AND MAKE SURE TO SET A REFERENCE TO DAO IF YOU DON'T ALREADY HAVE ONE.
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 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
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 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 |
|
|
Back to top |
|
|
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|