Manufacturing Information Solutions Forum Index Manufacturing Information Solutions
Your Place for Support and Discussions
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Export Query to Excel

 
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access
View previous topic :: View next topic  
Author Message
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Mon Sep 22, 2014 3:55 pm    Post subject: Export Query to Excel Reply with quote

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
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Mon Sep 22, 2014 3:56 pm    Post subject: Reply with quote

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
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
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