Untitled

VBA - Generate Excel File from Access (QueryTable)

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 = "m98DES;"

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

       

With wb.Worksheets(4)

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

End With

       

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

       

With MeuExcel.Worksheets(4).QueryTables.Add( _

    connection:=recordset, _

    Destination:=Range("A2"))

End With

       

Dim recordset As recordset

Set recordset = New recordset

       

Dim rs As recordset

       

Dim rs As New ADODB.Recordset

       

strConnect = "Provider=Microsoft.Access.OLEDB.10.0;Persist Security Info=True;" _

& "Data Source=XYZSQLEXPRESS;Integrated Security=SSPI;" _

& "Initial Catalog=TestDB;Data Provider=SQLOLEDB.1"

       

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