从访问表复制表并粘贴到空白的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

End Sub