CODEWITHSUNDEEP
excelvbams-access
Sebastian
Sebastian

Reputation: 13

Copy table from access table and paste into blank excel file

I am trying to accomplish the transfer of results from an access table into a blank Excel file that is not going to be saved. Basically I have a button on an access form that when pressed its action is going to just preview all the records in the access table in excel. This is the way the user wants it set up.

Right now I have code that will open a blank excel file but I am having troubles writing code that will copy the table from access and paste it into excel, say Cell "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

Upvotes: 0

Views: 1385

Answers (1)

Storax
Storax

Reputation: 12167

This could be a way

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

Upvotes: 1

Related Questions