Export A Query To Excel Using New FileDialog Object
Office 2007 and later versions provide the new Microsoft Office 12.0 or Later Object Library which can be used to create File Save Dialog Boxes, simplifying the coding required.
Details on this technology can be viewed at:
In the following example, I illustrate the form which calls the Save FileDialog Box, and then exports a query to Excel in the target directory and file name selected by the user.
Program Code
' *********************************************************************************
' This Form Exports A Query To Excel Targeting a Selected Directory And File Name
' Using The File Save Dialog Box Procedure
' *********************************************************************************
Option Compare Database
Option Explicit
Private Sub cmdExportToExcel_Click()
' *********************************************************************************
' This Form Exports A Query To Excel To A Selected Directory And File Name
' *********************************************************************************
Dim strTitle As String
Dim strFileNameToSave As String
Dim strFilePathAndName As String
' *********************************************************************************
' Set Up Parameters For The Call To the Save Dialog Box
' *********************************************************************************
strTitle = "Export Style Master to Excel"
strFileNameToSave = "StyleMaster-" & Format(Now(), "mm-dd-yyyy-hh-mm-ss") & ".xls"
' *********************************************************************************
' Call The Save Dialog Box With Parameters And Receive The Full Path And File Name
' Which Will Be The Target For the Excel Export
' *********************************************************************************
strFilePathAndName = cmdFileDialogSave(strTitle, strFileNameToSave)
' *********************************************************************************
' Exit if the user pressed cancel
' *********************************************************************************
If strFilePathAndName = "" Then
MsgBox ("File Not Saved")
Exit Sub
End If
' *********************************************************************************
' Transfer the query to Excel
' *********************************************************************************
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"qryExportStyleMaster", strFilePathAndName, True
' *********************************************************************************
' Close The Form
' *********************************************************************************
DoCmd.Close acForm, "frmExportExcel"
End Sub
Option Compare Database
Option Explicit
Public Function cmdFileDialogSave(strTitle As String, strFileName As String) As String
'*********************************************************************
' This Module Requires Including Microsoft OFFICE 12.0 Object Library
'*********************************************************************
Dim fDialog As Office.FileDialog
Dim strFileSelected As String
'****************************************************************
' Instantiate The File Dialog Object
'****************************************************************
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
'****************************************************************
' Set Up The File Dialog Parameters
'****************************************************************
With fDialog
.AllowMultiSelect = False
.Title = strTitle
.InitialFileName = strFileName
'****************************************************************
' Present the File Save Dialog Box
'****************************************************************
If .Show = True Then
strFileSelected = .SelectedItems(1)
Else
strFileSelected = ""
End If
End With
'****************************************************************
' Return The Full Path and File Name
'****************************************************************
cmdFileDialogSave = strFileSelected
End Function
A Simple Example
This module demonstrates how to export an Excel file from Microsoft Access.
Program Code
Option Compare Database
Option Explicit
' ********************************************************
' ******************* I M P O R T A N T ******************
' Add Microsoft Office 14 Object Library in VBA
' Tools, References - It is required to use the
' Application.FileDialog Method
' ********************************************************
Function SaveAQueryFromAccess()
' ****************************************************************************
' Export an Excel File From Microsoft Access Based On A Query
' This Function Presents the User With A File Save Dialog Box in Access
' And Provides an Initial File Name
' ****************************************************************************
Dim strFilePathToSave As String
Dim dlgSaveAs As FileDialog
strFilePathToSave = ""
Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = "SigmaNest" & Int((10000 * Rnd) + 1) & ".xlsx"
.Show
If .SelectedItems.Count < 1 Then
Exit Function
End If
strFilePathToSave = .SelectedItems(1)
End With
On Error GoTo ExportError
DoCmd.OutputTo acOutputQuery, "qryExportToExcel", "ExcelWorkbook(*.xlsx)", strFilePathToSave, False, "", , acExportQualityPrint
ExportExit:
Exit Function
ExportError:
MsgBox Error$
Resume ExportExit
End Function
'****************************************************************
' An Example To Set Initial Path
'****************************************************************
Option Compare Database
Option Explicit
Private Sub cmdExportRepSummary_Click()
Dim strFilePathToSave As String
Dim dlgSaveAs As FileDialog
strFilePathToSave = ""
Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = "C:\" & strSalesRepCode & "_RepSummary_" & Format(Now(), "mm-dd-yyyy-hh-mm-ss") & ".xls"
.Show
If .SelectedItems.Count < 1 Then
MsgBox ("File Not Saved")
Exit Sub
End If
strFilePathToSave = .SelectedItems(1)
End With
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"tblFCST1RepSummary", strFilePathToSave, True
DoCmd.Close acForm, "frmFCST1ExportMonthlyRepSummary"
End Sub