Solved Export Query to Excel Spreadsheet Tab (1 Viewer)

jeran042

Registered User.
Local time
Today, 15:02
Joined
Jun 26, 2017
Messages
127
I have a piece of code that works the way I expect it too.
On a form in my MS Access (2013) database there is a command button that will export an existing query out to a specific tab within an existing spreadsheet.

What I am looking for is some validation that this code is efficient or suggestions on how to improve. I am sort of new to VBA and this is as probably as far as I can take this code.
I am looking for a veteran to rip it apart.

Note: Even though this code has error handling, it is just place holder. I am not sure what types of errors I will encounter.

Here is what I have and any suggestions, edits or comments would be very helpful.
Thank you,

Code:
Private Sub Command46_Click()

Dim dbs As Database
Set dbs = CurrentDb

'Error handling
    On Error GoTo Error_Handler
    
'Specify the query to be exported
    Set rsQuery = dbs.OpenRecordset("qryREPORT_TEST")

'No server name specified
    On Error Resume Next
        Set excelApp = GetObject(, "Excel.Application")
    
    If Err.Number <> 0 Then
          Set xlx = CreateObject("Excel.Application")
    End If

' Change True to False if you do not want the workbook to be
' Visible when the code is running
    excelApp.Visible = False

'Open the target workbook
    Set targetWorkbook = excelApp.workbooks.Open("Y:\Budget process information\BUDGET DEPARTMENTS\" _
                                                   & "PROCUREMENT & MAIL SERVICES\Procurement_Test_021320.xlsm")

'Copy data to the specified sheet and range
    targetWorkbook.Worksheets("DETAIL").Range("A2").CopyFromRecordset rsQuery

'Clean up
'Close recordset
    rsQuery.Close
    Set rsQuery = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set excelApp = Nothing
    targetWorkbook.Close True
    Set targetWorkbook = Nothing
    Set excelApp = Nothing

'Confirmation the code ran as expected
    MsgBox "WOW, GOOD DEAL!", vbInformation, "NICE JOB!"

Error_Handler_Exit:
    Exit Sub

Error_Handler:
    Select Case Err.Number
        Case 2501
            Err.Clear
            Resume Error_Handler_Exit
        Case Else
            MsgBox "Error No. " & Err.Number & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
            Err.Clear
            Resume Error_Handler_Exit
    End Select
    
End Sub
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 17:02
Joined
Feb 28, 2001
Messages
27,001
When you do the "GetObject" you store what it gets in excelApp but when you Create the object you store it in xlx. That is going to make life tough.
 

Cronk

Registered User.
Local time
Tomorrow, 09:02
Joined
Jul 4, 2013
Messages
2,770
Doc, I believe the different extension happens when the spreadsheet is created, not the Excel application. The spreadsheet opened is of type xlsm and will be saved as that.

My issues with the code. Not all variables are declared. A different Excel app object is instantiated when Excel object is created (xlx instead of excelApp). The excel object is set to nothing twice (ie superfluous) - delete the first instance.
 

jeran042

Registered User.
Local time
Today, 15:02
Joined
Jun 26, 2017
Messages
127
Thank you both for your feedback. @Cronk, I have made the edits you spoke of, mainly declaring all the variables, and adjusting the xlx to excelApp.

Here is what my updated code looks like:

Code:
Private Sub Command46_Click()

Dim dbs As DAO.Database
Dim excelApp As Object
Dim rsQuery As DAO.Recordset
Dim targetWorkbook As Object

Set dbs = CurrentDb

'Error handling
    On Error GoTo Error_Handler
    
'Specify the query to be exported
    Set rsQuery = dbs.OpenRecordset("qryREPORT_TEST")

'No server name specified
    On Error Resume Next
        Set excelApp = GetObject(, "Excel.Application")
    
    If Err.Number <> 0 Then
          Set excelApp = CreateObject("Excel.Application")
    End If

' Change True to False if you do not want the workbook to be
' Visible when the code is running
    excelApp.Visible = False

'Open the target workbook
    Set targetWorkbook = excelApp.workbooks.Open("Y:\Budget process information\BUDGET DEPARTMENTS\" _
                                                   & "PROCUREMENT & MAIL SERVICES\Procurement_Test_021320.xlsm")

'Copy data to the specified sheet and range
    targetWorkbook.Worksheets("DETAIL").Range("A2").CopyFromRecordset rsQuery

'Clean up
'Close recordset
    rsQuery.Close
    Set rsQuery = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set excelApp = Nothing
    targetWorkbook.Close True
    Set targetWorkbook = Nothing

'Confirmation the code ran as expected
    MsgBox "WOW, GOOD DEAL!", vbInformation, "NICE JOB!"

Error_Handler_Exit:
    Exit Sub

Error_Handler:
    Select Case Err.Number
        Case 2501
            Err.Clear
            Resume Error_Handler_Exit
        Case Else
            MsgBox "Error No. " & Err.Number & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
            Err.Clear
            Resume Error_Handler_Exit
    End Select
    
End Sub

[\code]
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 17:02
Joined
Feb 28, 2001
Messages
27,001
Doc, I believe the different extension happens when the spreadsheet is created, not the Excel application. The spreadsheet opened is of type xlsm and will be saved as that.

My issues with the code. Not all variables are declared. A different Excel app object is instantiated when Excel object is created (xlx instead of excelApp). The excel object is set to nothing twice (ie superfluous) - delete the first instance.

Look at my comment again. I was naming his variables, not a file type. I called out the same thing you did.
 

Users who are viewing this thread

Top Bottom