Скопируйте таблицу из таблицы доступа и вставьте в пустой файл Excel

Question

Я пытаюсь выполнить перенос результатов из таблицы доступа в пустой файл Excel, который не будет сохранен. По сути, у меня есть кнопка в форме доступа, которая при нажатии ее действия собирается просто просмотреть все записи в таблице доступа в Excel. Это способ, которым пользователь хочет это настроить.

Сейчас у меня есть код, который откроет пустой файл Excel, но у меня возникли проблемы при написании кода, который скопирует таблицу из доступа и вставит ее в Excel, скажем, ячейка "A1"

Private Sub Command27_Click()
Dim dbs As DAO.Database
Dim Response As Integer
Dim strSQL As String
Dim Query1 As String
    Dim LTotal As String
    Dim Excel_App As Excel.Application 'Creates Blank Excel File
    Dim strTable As String ' Table in access


     strTable = "tbPrintCenter05Que" 'Access table I am trying to copy
     Set Excel_App = CreateObject("Excel.Application")
     Set dbs = CurrentDb

     Excel_App.Visible = True
     Excel_App.Workbooks.Add
With Excel_App
.Columns("A:ZZ").ColumnWidth = 25
.Copy ' Getting error on this line 
.Range ("A")
.Paste

Answer 1

Это может быть способ

Private Sub Command27_Click()
    Dim dbs As dao.Database
    Dim Response As Integer
    Dim strSQL As String
    Dim Query1 As String

    Dim LTotal As String
    Dim Excel_App As Excel.Application 'Creates Blank Excel File
    Dim strTable As String ' Table in access


    strTable = "tbPrintCenter05Que" 'Access Query I am trying to copy
    Set Excel_App = CreateObject("Excel.Application")
    Set dbs = CurrentDb

    Dim rs As dao.Recordset
    Set rs = dbs.OpenRecordset(strTable)

    Excel_App.Visible = True

    Dim wkb As Excel.Workbook
    Set wkb = Excel_App.Workbooks.Add

    Dim rg As Excel.Range
    Dim i As Long
    ' Add the headings
    For i = 0 To rs.Fields.Count - 1
        wkb.Sheets(1).Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i

    Set rg = wkb.Sheets(1).Cells(2, 1)
    rg.CopyFromRecordset rs

    ' make pretty
    rg.CurrentRegion.EntireColumn.AutoFit

End Sub