Question

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

1。）允许我将查询导出到Excel。 2.）每次运行Query时创建一个新工作表 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对象显示为可见，但尚未将其保存或关闭。

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

1 个答案: