VBA - Создать файл Excel из Access (QueryTable) - PullRequest
Новая
       31

VBA - Создать файл Excel из Access (QueryTable)

8 голосов
/ 03 января 2012

У меня есть проект, основной целью которого является создание 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')

Полный код (отредактировано с помощью советов Ремоу): 

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

Ответы [ 3 ]

5 голосов
/ 03 января 2012

В 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

Поставщик должен быть поставщиком Access 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"
3 голосов
/ 04 января 2012

FWIW, выделяются две вещи:

  1. Как указал @Remou, ссылки на Excel должны быть квалифицированы. В настоящее время Range("A2") является неквалифицированным. При запуске кода в Excel предполагается ActiveSheet. Однако при запуске из другого приложения это приложение будет искать метод или свойство в своей собственной библиотеке с именем Range, что приведет к ошибке в Microsoft Access.

  2. В блоке With нет кода, поэтому вы можете удалить ключевые слова With и End With; когда вы делаете это, также удаляете external (), вот так:

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

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

Вы не говорите, какая версия Office, но в Excel 2007/10 QueryTable является свойством объекта Listobject, поэтому ваш код будет выглядеть так: 

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