• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 462
  • Last Modified:

Access export to excel with VBA

Hello, I want to use the following code to export a query to excel.

With the code I do not get an error, but the file is not created.

Additionally, it would be great if the path where I save the excel file is the current users desktop.

Private Sub Command98_Click()
Dim dbs As DAO.Database
 Dim qdfTemp As DAO.QueryDef
 Dim strSQL As String, strQDF As String
 Set dbs = CurrentDb

 strSQL = "SELECT [DMR Tracking].[DMR#], [DMR Tracking].[DATE ISSUED], [DMR Tracking].[HOLD/SORT], [DMR Tracking].SCRAP," _
 & "[DMR Tracking].RTV, [DMR Tracking].[RMA FROM SUPPLIER], [DMR Tracking].[COMMENT 1], [DMR Tracking].[COMMENT 2]," _
 & "[DMR Tracking].[DMR DATE CLOSED], [DMR Tracking].VOID, [DMR Tracking].ShipperId FROM [DMR Tracking];"

strQDF = "_TempQuery_"
 Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
 qdfTemp.Close
 Set qdfTemp = Nothing

 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
       strQDF, "C:\MyFileName.xls"

dbs.QueryDefs.Delete strQDF
 dbs.Close
 Set dbs = Nothing

End Sub

Open in new window

0
gogetsome
Asked:
gogetsome
  • 2
  • 2
1 Solution
 
mbizupCommented:
Give this a try:

Private Sub Command98_Click()
Dim dbs As DAO.Database
 Dim qdfTemp As DAO.QueryDef
 Dim strSQL As String, strQDF As String
 Set dbs = CurrentDb

 strSQL = "SELECT [DMR Tracking].[DMR#], [DMR Tracking].[DATE ISSUED], [DMR Tracking].[HOLD/SORT], [DMR Tracking].SCRAP," _
 & "[DMR Tracking].RTV, [DMR Tracking].[RMA FROM SUPPLIER], [DMR Tracking].[COMMENT 1], [DMR Tracking].[COMMENT 2]," _
 & "[DMR Tracking].[DMR DATE CLOSED], [DMR Tracking].VOID, [DMR Tracking].ShipperId FROM [DMR Tracking];"

strQDF = "_TempQuery_"
 Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
 qdfTemp.Close
 Set qdfTemp = Nothing

 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
       qdfTemp.Name , "C:\MyFileName.xls"

dbs.QueryDefs.Delete qdfTemp 
 dbs.Close
 Set dbs = Nothing

End Sub

Open in new window

0
 
gogetsomeAuthor Commented:
Thank you once again for helping!

I'm getting a compile error: Type mismatch on this line:

dbs.QueryDefs.Delete qdfTemp
0
 
mbizupCommented:
Actually, your original code seems to work for me.  Try a folder other than C:\.  

This will write it to the desktop:
Dim dbs As DAO.Database
 Dim qdfTemp As DAO.QueryDef
 Dim strSQL As String, strQDF As String
 
 Dim objWSH As Object
 Set objWSH = CreateObject("WScript.Shell")
     
     'On Error GoTo ErrorHandler
     ' Create a shell object
 Set dbs = CurrentDb

 strSQL = "SELECT [DMR Tracking].[DMR#], [DMR Tracking].[DATE ISSUED], [DMR Tracking].[HOLD/SORT], [DMR Tracking].SCRAP," _
 & "[DMR Tracking].RTV, [DMR Tracking].[RMA FROM SUPPLIER], [DMR Tracking].[COMMENT 1], [DMR Tracking].[COMMENT 2]," _
 & "[DMR Tracking].[DMR DATE CLOSED], [DMR Tracking].VOID, [DMR Tracking].ShipperId FROM [DMR Tracking];"


strQDF = "TempQuery"
 Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)


 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
       strQDF, objWSH.SpecialFolders("Desktop") & "\MyFileName.xls", True


 qdfTemp.Close
 Set qdfTemp = Nothing
set objWSH = nothing
dbs.QueryDefs.Delete strQDF

 dbs.Close
 Set dbs = Nothing

End Function

Open in new window

0
 
gogetsomeAuthor Commented:
Excellent! Thank you so much!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now