在创建新工作表和格式化时将 Access 查询导出到 Excel

Question

我在 Access 中有一个数据库，简而言之，就是一长串公司、他们销售的产品以及他们每个产品的财务销售额。我想写一些 VBA：

1.) 允许我将查询导出到 Excel。 2.) 每次运行查询时创建一个新工作表 3.) 格式化呈现的数据。

我似乎也不知道如何将查询中的数据粘贴到新工作表中。如果有好心人能帮助我，将不胜感激。

我知道这一切都是可能的，因为我已经对此进行了大量研究。但是我已经没有时间了，现在只需要弄清楚我哪里出错了。到目前为止，这是我所看到的基本内容：(Access VBA How to add new sheets to excel?)、(Formatting outputted Excel files from Access using VBA?)、(https://www.youtube.com/watch?v=9yDmhzv7nns)。

Sub Mysub()
Dim objexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim wbExists As Boolean
Dim qdfQUERY2014sales As QueryDef
Dim rsQUERY2014sales As Recordset

Set qdfQUERY2014sales = CurrentDb.QueryDefs("QUERY2014sales")
Set rsQUERY2014sales = qdfQUERY2014sales.OpenRecordset()

Set objexcel = CreateObject("excel.Application")


On Error GoTo Openwb
wbExists = False
Set wbexcel = objexcel.Workbooks.Open("C:\Users\MORTBANKER\Documents\test.xls")
wbExists = True

Openwb:
On Error GoTo 0
If Not wbExists Then
    Set wbexcel = objexcel.Workbooks.Add()
End If

CopyToWorkbook wbexcel
End Sub

Private Sub CopyToWorkbook(objWorkbook As Excel.Workbook)
Dim newWorksheet As Excel.Worksheet
Set newWorksheet = objWorkbook.Worksheets.Add()

 With newWorksheet
.Range("A1") = rsQUERY2014sales
.columns("A:A").HorizontalAlignment = xlRight
.rows("1:1").Font.Bold = True
End With
'Copy stuff to the worksheet here'
End Sub

Answer 1

您需要将记录集对象传递给伴随子，并使用 Excel.Application 对象的Range.CopyFromRecordset method 来执行实际操作。

Sub Mysub()
    Dim objexcel As Excel.Application
    Dim wbexcel As Excel.Workbook
    Dim wbExists As Boolean
    Dim qdfQUERY2014sales As QueryDef
    Dim rsQUERY2014sales As Recordset

    Set qdfQUERY2014sales = CurrentDb.QueryDefs("QUERY2014sales")
    Set rsQUERY2014sales = qdfQUERY2014sales.OpenRecordset()

    Set objexcel = CreateObject("excel.Application")
    objexcel.Visible = True


    On Error GoTo Openwb
    wbExists = False
    Set wbexcel = objexcel.Workbooks.Open("C:\Users\MORTBANKER\Documents\test.xls")
    wbExists = True

Openwb:
    On Error GoTo 0
    If Not wbExists Then
        Set wbexcel = objexcel.Workbooks.Add()
    End If

    CopyToWorkbook wbexcel, rsQUERY2014sales

    'need to save the workbook, make it visible or something.
End Sub

Private Sub CopyToWorkbook(objWorkbook As Excel.Workbook, rsQRY As Recordset)
    Dim newWorksheet As Excel.Worksheet
    Set newWorksheet = objWorkbook.Worksheets.Add()

     With newWorksheet
        .Range("A1").CopyFromRecordset rsQRY   '<-magic happens here!
        .columns("A:A").HorizontalAlignment = xlRight
        .rows("1:1").Font.Bold = True
    End With
    'Copy stuff to the worksheet here'
End Sub

您不会获得字段名称；这将不得不从另一个操作中放入。如果您知道字段名称，您可能希望将它们存储在一个变量数组中，然后将它们全部存储到第 1 行中。我已使 objexcel 对象可见，但尚未保存或关闭它。