VBA - 从 Access (QueryTable) 生成 Excel 文件

VBA - Generate Excel File from Access (QueryTable)

提问by Predoff

I have a project that basically the goal is to generate Excel (Report) starting the Click of a button in Access using VBA.

我有一个项目，基本上目标是生成 Excel（报告），开始使用 VBA 在 Access 中单击按钮。

The contents of this report is the result of a Stored Procedure SQL Server Database.

此报告的内容是存储过程 SQL Server 数据库的结果。

the line of error:

错误行：

With MeuExcel.Worksheets(4)
    .QueryTables.Add connection:=rs, Destination:=.Range("A2")
End With

I get is:

我得到的是：

invalid procedure call or argument (erro '5')

Complete Code (Edited using Remou User tips):

完整代码（使用 Remou 用户提示编辑）：

Sub GeraPlanilhaDT()

Dim MeuExcel As New Excel.Application
Dim wb As New Excel.Workbook

Set MeuExcel = CreateObject("Excel.Application")
MeuExcel.Workbooks.Add

MeuExcel.Visible = True

Dim strNomeServidor, strBaseDados, strProvider, strConeccao, strStoredProcedure As String

strNomeServidor = "m98\DES;"
strBaseDados = "SGLD_POC;"
strProvider = "SQLOLEDB.1;"
strStoredProcedure = "SP_ParametrosLeads_DT"

strConeccao = "Provider=" & strProvider & "Integrated Security=SSPI;Persist Security Info=True;Data Source=" & strNomeServidor & "Initial Catalog=" & strBaseDados

Dim cnt As New ADODB.connection
Dim cmd As New ADODB.command
Dim rs As New ADODB.recordset
Dim prm As New ADODB.parameter

cnt.Open strConeccao

cmd.ActiveConnection = cnt
cmd.CommandType = adCmdStoredProc
cmd.CommandText = strStoredProcedure
cmd.CommandTimeout = 0

Set prm = cmd.CreateParameter("DT", adInteger, adParamInput)
cmd.Parameters.Append prm 
cmd.Parameters("DT").Value = InputBox("Digite o Código DT", "Código do Distribuidor")

Set rs = cmd.Execute()

Dim nomeWorksheetPrincipal As String
nomeWorksheetPrincipal = "Principal"

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nomeWorksheetPrincipal



With MeuExcel.Worksheets(4)
    .QueryTables.Add connection:=rs, Destination:=.Range("A2")
End With


cnt.Close
Set rs = Nothing
Set cmd = Nothing
Set strNomeServidor = Nothing
Set strBaseDados = Nothing
Set strProvider = Nothing

If (ActiveSheet.UsedRange.Rows.Count > 1) Then
    FormataDadosTabela
Else
    MsgBox ("N?o foi encontrado nenhum Distribuidor com esse DT")
End If


End Sub

The strange thing is that the code works when run in Excel but does not work in Access

奇怪的是，该代码在 Excel 中运行时有效，但在 Access 中不起作用

回答by Fionnuala

In Access, you need to prefix the Excel application objects with the Excel application instance, for example:

在 Access 中，您需要使用 Excel 应用程序实例作为 Excel 应用程序对象的前缀，例如：

With MeuExcel.Worksheets(4).QueryTables.Add( _
    connection:=recordset, _
    Destination:=Range("A2"))
End With

Furthermore, unless you have a reference to the Excel library, ypu will need to provide the value for built-in Excel constants.

此外，除非您引用 Excel 库，否则 ypu 将需要提供内置 Excel 常量的值。

It is a very bad idea to use the name of objects for variables. Do not say:

将对象的名称用于变量是一个非常糟糕的主意。别说：

Dim recordset As recordset
Set recordset = New recordset

Say, for example:

比如说：

Dim rs As recordset

Or much better:

或者更好：

Dim rs As New ADODB.Recordset

If you have a suitable reference. You can then skip CreateObject.

如果你有合适的参考。然后您可以跳过 CreateObject。

EDIT

编辑

The provider must be the Access OLEDB 10 provider, as used to bind recordsets. This works for me to create a data table via Access using SQL Server:

提供程序必须是用于绑定记录集的 Access OLEDB 10 提供程序。这适用于我使用 SQL Server 通过 Access 创建数据表：

strConnect = "Provider=Microsoft.Access.OLEDB.10.0;Persist Security Info=True;" _
& "Data Source=XYZ\SQLEXPRESS;Integrated Security=SSPI;" _
& "Initial Catalog=TestDB;Data Provider=SQLOLEDB.1"

回答by Rachel Hettinger

FWIW, two things stand out:

FWIW，有两件事很突出：

1. As @Remou pointed out, Excel references need to be qualified. Currently, Range("A2")is unqualified. When running the code in Excel, the ActiveSheetis assumed. However, when running from another application, that application will look for a method or property in its own library called Range, which will give you that error in Microsoft Access.

2. There isn't any code in the Withblock, so you can remove the Withand End Withkeywords; when you do this also remove the outer (), like this:

1. 正如@Remou 指出的那样，需要限定 Excel 引用。目前，Range("A2")不合格。在 Excel 中运行代码时，ActiveSheet假定为 。但是，当从另一个应用程序运行时，该应用程序将在其自己的名为 的库中查找方法或属性Range，这将在 Microsoft Access 中为您提供该错误。

2. With块中没有任何代码，因此您可以删除With和End With关键字；执行此操作时，还要删除外部 ()，如下所示：

wb.Worksheets(4).QueryTables.Add Connection:=rs, Destination:=wb.Worksheets(4).Range("A2")

wb.Worksheets(4).QueryTables.Add Connection:=rs, Destination:=wb.Worksheets(4).Range("A2")

Alternatively, shift the Withblock to the Worksheetlevel:

或者，将With块移动到Worksheet级别：

With wb.Worksheets(4)
    .QueryTables.Add Connection:=rs, Destination:=.Range("A2")
End With

---

---

Update—Access to Excel Sample

更新 - 访问 Excel 示例

This sample code automates Excel from Access, creating a new workbook and adding a Querytable to the first sheet. The source data is an Access table. This runs in Office 2007.

此示例代码从 Access 自动执行 Excel，创建新工作簿并将查询表添加到第一个工作表。源数据是一个 Access 表。这在 Office 2007 中运行。

Public Sub ExportToExcel()
  Dim appXL As Excel.Application
  Dim wbk As Excel.Workbook
  Dim wst As Excel.Worksheet
  Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset

  Set appXL = CreateObject("Excel.Application")
  appXL.Visible = True
  Set wbk = appXL.Workbooks.Add
  Set wst = wbk.Worksheets(1)

  Set cn = CurrentProject.AccessConnection
  Set rs = New ADODB.Recordset
  With rs
    Set .ActiveConnection = cn
    .Source = "SELECT * FROM tblTemp"
    .Open
  End With

  With wst
    .QueryTables.Add Connection:=rs, Destination:=.Range("A1")
    .QueryTables(1).Refresh
  End With

End Sub

回答by Doug Glancy

You don't say what Office version, but in Excel 2007/10 a QueryTable is a property of a Listobject so your code would be like:

您没有说明是什么 Office 版本，但在 Excel 2007/10 中，QueryTable 是 Listobject 的一个属性，因此您的代码将类似于：

With MeuExcel.Worksheets.ListObjects.Add(Connection:=rs, Destination:=Range("A2")).QueryTable