Export Qry to Excel

[Purdue2479]

I am trying to use the below code to export a query from access to excel. I would like to modify the code to paste the data "as values" into an already created excel workbook with formatted columns. I'm not sure how to point to the workbook or keep the excel column formatting when exported. Any help would be appreciated.

Sub Export_Qry()

Dim db As DAO.Database
Dim rs As DAO.Recordset
'Set db = DAO.DBEngine.Workspaces(0).OpenDatabase( _
"C:\database.mdb")
Set db = CurrentDb
Set rs = db.OpenRecordset("qryWholesaler_Summary_Final", dbOpenSnapshot)

'Start a new workbook in Excel
Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet

Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)

'Add the field names in row 1
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 2 To iNumCols
oSheet.Cells(5, i).Value = rs.Fields(i - 1).Name
Next

'Add the data starting at cell A2
oSheet.Range("B6").CopyFromRecordset rs

'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
End With

oApp.Visible = True
oApp.UserControl = True

'Close the Database and Recordset
rs.Close
'db.Close

End Sub

 

[Purdue2479]

After doing some testing, I discovered that the export from access to excel does not modify the formatting in excel. Below is what I used.

Sub Export_Qry()

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    'Set db = DAO.DBEngine.Workspaces(0).OpenDatabase( _
    "C:\database.mdb")
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Query", dbOpenSnapshot)

'Start a new workbook in Excel
    Dim oApp As New Excel.Application
    
    Set oBook = oApp.Workbooks.Open("FilePath")
    Set oSheet = oBook.Worksheets(1)

'Add the field names in row 1
    Dim i As Integer
    Dim iNumCols As Integer
    
    iNumCols = rs.Fields.Count
    
    For i = 1 To iNumCols
        oSheet.Cells(6, i + 1).Value = rs.Fields(i - 1).Name
    Next

'Add the data starting at cell B6
    oSheet.Range("B7").CopyFromRecordset rs

    Call Add_Totals

'Format the header row as bold and autofit the columns
    With oSheet.Range("B6").Resize(1, iNumCols)
    .Font.Bold = True
    '.EntireColumn.AutoFit
    End With

    oApp.Visible = True
    oApp.UserControl = True

'Close the Database and Recordset
rs.Close
Set oBook = Nothing
Set oSheet = Nothing
'db.Close

End Sub



Sub Add_Totals()

    Dim lastrow As Long
    Dim i As Integer
              
    Set oSheet = oBook.Worksheets(1)

    lastrow = oSheet.Cells(Rows.Count, "B").End(xlUp).Row

    oSheet.Cells(lastrow + 2, 2).Select
    ActiveCell.FormulaR1C1 = "Totals"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    
    For i = 3 To 12
       Cells(lastrow + 2, i).FormulaR1C1 = "=SUM(R[-31]C:R[-1]C)"
    
   Next i
End Sub