VBA - 从Access生成Excel文件（QueryTable）

Question

我有一个项目，其基本目标是生成Excel（报告），使用VBA启动Access中的单击按钮。

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

错误的行：

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

我得到的是：

invalid procedure call or argument (erro '5')

完整代码（使用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

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

Answer 1

在Access中，您需要在Excel应用程序对象前加上Excel应用程序实例，例如：

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

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

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

Dim recordset As recordset
Set recordset = New recordset

比方说，例如：

Dim rs As recordset

或者更好：

Dim rs As New ADODB.Recordset

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

编辑

提供程序必须是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"

Answer 2

FWIW，两件事突出：

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

2. With块中没有任何代码，因此您可以删除With和End With关键字; 当你这样做时也删除outer（），如下所示：

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

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

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

---

更新 - 访问Excel示例

此示例代码从Access自动化Excel，创建新工作簿并将Querytable添加到第一个工作表。 源数据是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

Answer 3

你没有说什么是Office版本，但是在Excel 2007/10中，QueryTable是Listobject的一个属性，所以你的代码就像：

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