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

Question

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

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

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

我知道这一切都是可能的，因为我对此做了很多研究。但是我运行没时间了，现在只需要找出我哪里出错了。这是我目前所见的基本内容：(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 对象可见但尚未保存或关闭它。

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

Exporting Access Query to Excel while creating new sheets and formating

excel

ms-access

vba

ms-access-2013