VBA - Генерировать файл Excel из Access (QueryTable)

Question

У меня есть проект, который в основном предназначен для создания Excel (Report), начиная с нажатия кнопки в Access с использованием VBA.

Содержание этого отчета является результатом хранимой процедуры SQL Server Database.

линия ошибки:

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, певце необходимо предоставить значение для встроенного - в константах Excel.

Это очень плохая идея использовать имя объекта для переменных. Не говорите:

Dim recordset As recordset 
Set recordset = New recordset 

Say, например:

Dim rs As recordset 

или намного лучше:

Dim rs As New ADODB.Recordset 

Если у вас есть подходящая ссылка. Затем вы можете пропустить CreateObject.

РЕДАКТИРОВАТЬ

Поставщик услуг должен быть поставщик OLEDB доступа 10, используемый для связывания наборов записей. Это работает для меня, чтобы создать таблицу данных с помощью Access с помощью 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 код не указан, поэтому вы можете удалить ключевые слова ; когда вы делаете это также удалить внешний(), например:

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 

---

update- Доступ к образцу Excel

Этот пример кода автоматизирует Excel из Access, создавая новую книгу и добавляя Querytable к первому листу. Исходными данными являются таблица Access. Это работает в офисе 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