VBA - 从访问生成Excel文件（QueryTable）

Question

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

此报告的内容是存储过程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。

EDIT

供应商必须访问OLEDB 10提供程序，如用于结合记录集。这对我的作品通过访问使用SQL Server中创建数据表：

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关键字;当这样做也去除外层（），是这样的：

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