Importing data from Access to Excel using Access VBA - excel

Question

I'd like to ask you for the help with the Access VBA code, that would import all the data from 1 specified query table from the Access database (currently open database) to MS Excel (the file, that could be selected by the user).
I'm currently having this piece of code, but I'm getting the error message saying:
"Run-time error '-2147023170 (800706be)':
Automation error The remote procedure call failed."
Would any of you know how to fix the connection?
Option Explicit
Option Compare Database
Public Sub CopyRstToExcel_test()
'On Error GoTo CopyRstToExcel_Err
Dim sPath As String
Dim fd As FileDialog
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrSht As Object
Dim dbs 'Added
Dim qdfName As String
Dim fRecords As Boolean
Dim rst As dao.Recordset
Dim iCols As Integer
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Select the file and identify the path leading to the file
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Define database you want to work with
Set dbs = CurrentDb
'Select the Excel file you want to work with
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Define the path
If fd.Show = -1 Then
sPath = fd.SelectedItems(1)
End If
MsgBox sPath
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Defining names of variables
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Defining variables (queries/tables)
qdfName = "Query_1"
'------------------------------------------------------------------------------------------------
'Copying the data from Access into the new Excel
'------------------------------------------------------------------------------------------------
Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)
fRecords = False
If rst.EOF = False Then
fRecords = True
Set oExcel = CreateObject("Excel.Application")
Set oExcelWrkBk = GetObject(sPath)
oExcel.Visible = True
oExcel.ScreenUpdating = False
Set oExcelWrSht = oExcelWrkBk.Sheets(1)
For iCols = 0 To rst.Fields.Count - 1
oExcelWrSht.Cells(9, iCols + 2).Value = rst.Fields(iCols).Name
Next
oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
oExcelWrSht.Cells(9, rst.Fields.Count)).Font.Bold = True
oExcelWrSht.Range("B10").CopyFromRecordset rst
oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
oExcelWrSht.Cells(rst.RecordCount + 9, rst.Fields.Count)).Columns.AutoFit
oExcelWrSht.Range("A1").Select
End If
'------------------------------------------------------------------------------------------------
CopyRstToExcel_Done:
On Error Resume Next
If fRecords = True Then
oExcel.Visible = True
oExcel.ScreenUpdating = True
End If
Set oExcelWrSht = Nothing
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Set rst = Nothing
''Error message:
'CopyRstToExcel_Err:
' MsgBox Err & ": " & Error, vbExclamation
' Resume CopyRstToExcel_Done
' Resume
'------------------------------------------------------------------------------------------------
End Sub
In this step, I only want to copy the data in the first sheet, but later on I would also like to specify the name of the sheet and I've got already prepared templates I want to copy the data over.
Thank you for your help!

Answer 1

Try to replace
Set oExcelWrkBk = GetObject(sPath)
by
Set oExcelWrkBk = oExcel.Workbooks.Open(sPath)
Also I'd recommend to replace
Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)
by
Set rst = dbs.OpenRecordset(qdfName, dbOpenSnapshot)
Open specified worksheet:
Set oExcelWrSht = oExcelWrkBk.Sheets("MyWorksheetName")