从访问表中复制表并粘贴到空白的 Excel 文件中

Question

我正在尝试将结果从访问表传输到不会保存的空白 Excel 文件中。基本上，我在访问表单上有一个按钮，当按下它时，它的动作将只是预览 excel 中访问表中的所有记录。这是用户希望它设置的方式。

现在我的代码可以打开一个空白的 excel 文件，但我在编写代码时遇到了麻烦，该代码将从 access 中复制表格并将其粘贴到 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