[Resolvido]Exportar Consulta para Excell 2007

Bom dia a todos deste grande forum,

Estou aqui mais uma vez para pedir ajuda de voces, tenho uma consulta chamado ExportExcelDependente onde consta (Mat,Data_Vencimento, Nome, Data_Nas, Data_Adesao, Form_Pg_Consigando etc..).

Encontrei aqui no forum um exemplo com nome de AccessToExcel.
Neste exemplo mostra como exportar por data inicial e data final mais gostaria tambem como Forma de Pagamento.

Teria como voces transformar este exemplo para 3 itens.
Data Inicial
Data Final
Forma de Pagamento.

Tentei fazer mais sou fraco em visual basic, poderiam me dar uma força encontra onde estou errando.

Segue abaixo o codigo.

Option Compare Database
Option Explicit
Dim MinhaDataI, MinhaDataF, CampoC

Private Sub Comando4_Click()
On Error GoTo Err_Comando4_Click
Dim sql As String
If IsNull(Me.DataInicial) Or (Me.DataFinal) Or IsNull(Me.Campo) Then Exit Sub
DoCmd.Hourglass True
MinhaDataI = Format((Forms![Frm_ExportarFatDep]![DataInicial]), "mm/dd/yy")
MinhaDataF = Format((Forms![Frm_ExportarFatDep]![DataFinal]), "mm/dd/yy")
CampoC = Format((Forms![Frm_ExportarFatDep]![Campo]))

sql = "SELECT Mat_Siape, Data_Vencimento, Nome_Dependente,"
sql = sql & " Data_Nascimento, Dt_Admissão, Apólice,"
sql = sql & " Cap_Segurado, Sexo, CPF,"
sql = sql & " Valor_Dep, Form_Pg_Segurado"
sql = sql & " FROM ExportaExcelDependente"
sql = sql & " WHERE " & "Data_Vencimento>=" & "#" & MinhaDataI & "# Data_Vencimento<=" & "#" & MinhaDataF & "# and form_pg_segurado=" & "#" & CampoC & "#"


Call ExportarParaExcelII(sql, Me.DataInicial, Me.DataFinal, Me.Campo)


Exit_Comando4_Click:
DoCmd.Hourglass False
Exit Sub

Err_Comando4_Click:
MsgBox err.Description
Resume Exit_Comando4_Click

End Sub


Private Sub DataFinal_AfterUpdate()
Call Form_Load
End Sub

Private Sub DataInicial_AfterUpdate()
If Not IsNull(Me.DataFinal) Then
Call Form_Load
End If
End Sub
Private Sub Campo_AfterUpdate()
Call Form_Load
End Sub
Private Sub Form_Load()
Dim sql As String
MinhaDataI = Format((Forms![Frm_ExportarFatDep]![DataInicial]), "mm/dd/yy")
MinhaDataF = Format((Forms![Frm_ExportarFatDep]![DataFinal]), "mm/dd/yy")
CampoC = Format((Forms![Frm_ExportarFatDep]![Campo]))

sql = "SELECT Mat_Siape, Data_Vencimento, Nome_Dependente,"
sql = sql & " Data_Nascimento, Dt_Admissão, Apólice,"
sql = sql & " Cap_Segurado, Sexo, CPF,"
sql = sql & " Valor_Dep, Form_Pg_Segurado"
sql = sql & " From ExportaExcelDependente"
If Not IsNull(Me.DataFinal) Or Me.DataFinal Or Me.Campo <> "" Then
sql = sql & " WHERE " & "Data_Vencimento>=" & "#" & MinhaDataI & "# Data_Vencimento<=" & "#" & MinhaDataF & "# and form_pg_segurado=" & "#" & CampoC & "#"
End If
sql = sql & " ORDER BY Data_Vencimento DESC"
Me.ListPedidos.RowSource = sql
End Sub

# é usado para data e hora. Tire ele do outro campo.

Coloquei conforme voce orientou, mais nada aconteceu.

Private Sub Comando4_Click()
On Error GoTo Err_Comando4_Click
Dim sql As String
If IsNull(Me.DataInicial) Or (Me.DataFinal) Or IsNull(Me.Campo) Then Exit Sub
DoCmd.Hourglass True
MinhaDataI = Format((Forms![Frm_ExportarFatDep]![DataInicial]), "mm/dd/yy")
MinhaDataF = Format((Forms![Frm_ExportarFatDep]![DataFinal]), "mm/dd/yy")
CampoC = Format((Forms![Frm_ExportarFatDep]![Campo]))

sql = "SELECT Mat_Siape, Data_Vencimento, Nome_Dependente,"
sql = sql & " Data_Nascimento, Dt_Admissão, Apólice,"
sql = sql & " Cap_Segurado, Sexo, CPF,"
sql = sql & " Valor_Dep, Form_Pg_Segurado"
sql = sql & " FROM ExportaExcelDependente"
sql = sql & " WHERE " & "Data_Vencimento>=" & "#" & MinhaDataI & "# Data_Vencimento<=" & "#" & MinhaDataF & " and form_pg_segurado=" & CampoC & ""


Call ExportarParaExcelII(sql, Me.DataInicial, Me.DataFinal, Me.Campo)


Exit_Comando4_Click:
DoCmd.Hourglass False
Exit Sub

Err_Comando4_Click:
MsgBox err.Description
Resume Exit_Comando4_Click

End Sub

Este código está uma bagunçada.

Isto serve para formatar o quê ?

CampoC = Format((Forms![Frm_ExportarFatDep]![Campo]))

E isto ?

sql = sql & " WHERE " & "Data_Vencimento

E isto ?

& "# Data_Vencimento<=" & "#" & MinhaDataF

Confirme o que está a vermelho, o resto foi rectificado.


Dim sql As String
If IsNull(Me.DataInicial) Or (Me.DataFinal) Or IsNull(Me.Campo) Then Exit Sub
DoCmd.Hourglass True
MinhaDataI = Format((Forms![Frm_ExportarFatDep]![DataInicial]), "mm/dd/yy")
MinhaDataF = Format((Forms![Frm_ExportarFatDep]![DataFinal]), "mm/dd/yy")
CampoC = Forms![Frm_ExportarFatDep]!]Campo]

sql = "SELECT Mat_Siape, Data_Vencimento, Nome_Dependente,"
sql = sql & " Data_Nascimento, Dt_Admissão, Apólice,"
sql = sql & " Cap_Segurado, Sexo, CPF,"
sql = sql & " Valor_Dep, Form_Pg_Segurado"
sql = sql & " FROM ExportaExcelDependente"
sql = sql & " WHERE Data_Vencimento >= #" & MinhaDataI & "# AND Data_Vencimento <= #" & MinhaDataF & "# AND form_pg_segurado='" & CampoC & "'"

Bom este codigo eu peguei neste forum, e um programa chamado AccessToExcell tentei adaptar mais nao conseguir.

Este nome Campo e a Forma de Pagamento.
Ex.:
Data Inicial = Data_Vencimento
Data Final = Data_Vencimento
Campo = Forma de Pagamento.

mais tem o modulo

Option Compare Database
Option Explicit


Public Sub ExportarParaExcelII(ByVal ssql As String, _
ByVal sDataInicial As String, ByVal sDataFinal As String, ByVal sCampo As String)
'Envia dados de uma consulta ou tabela para o Excel
'Autor: Carlos Moura em 10/05/2000 e-mail: crpmoura@ig.com.br

Dim DB As Database, iLinha As Integer, intCampos As Integer
Dim I As Integer, XPlanilha As Object, sTemp As String
Dim Rd As Recordset

Set DB = CurrentDb
Set Rd = DB.OpenRecordset(ssql, dbOpenForwardOnly)
If Rd.RecordCount > 0 Then
'cria referencia ao EXCEL
Set XPlanilha = CreateObject("Excel.Application")

'cria uma pasta de planilhas
XPlanilha.Workbooks.Add

'seleciona a primeira planilha
XPlanilha.Workbooks(1).Sheets(1).Select

'incrementa a linha
iLinha = iLinha + 1

'insere texto e data na planilha
XPlanilha.Range("A" & CStr(iLinha)).Value _
= "Intervalo de Pesquisa de " & sDataInicial & " a " & sDataFinal & " a " & sCampo
'Aplica negrito
XPlanilha.Range("A" & CStr(iLinha)).Font.Bold = True
'Aplica cor azul
XPlanilha.Range("A" & CStr(iLinha)).Font.ColorIndex = 5

intCampos = Rd.Fields.Count

For I = 0 To intCampos - 1
'coloca o titulo dos campos na 2 linha
XPlanilha.Cells(2, I + 1).Value = Rd.Fields(I).Name
'aplica negrito
XPlanilha.Cells(2, I + 1).Font.Bold = True
Next I

iLinha = iLinha + 1

'transfere os dados
Do While Not Rd.EOF
iLinha = iLinha + 1 'incrementa a linha
I = 0
For I = 0 To intCampos - 1
XPlanilha.Cells(iLinha, I + 1).Value = Rd(I)
If IsDate(Rd(I)) Then
XPlanilha.Cells(iLinha, I + 1).NumberFormat = "dd/mm/YY"
End If
Next I
Rd.MoveNext
Loop

'formata novo nome da planilha
sTemp = "C:\Temp\Rel" & Format(Now, "ddmmyy_hhnn") & ".xls"
'se o diretório não existe, cria
If Dir$("C:\Temp", vbDirectory) = "" Then MkDir "C:\Temp"
'se o arquivo já existe, deleta
If Dir$(sTemp) <> "" Then Kill sTemp

'salva a planilha
XPlanilha.ActiveWorkbook.SaveAs FileName:=sTemp, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'fecha o Excel
XPlanilha.Quit
'descarrega da memória
Set XPlanilha = Nothing
End If
Rd.Close
Set Rd = Nothing
Set DB = Nothing
MsgBox "A planilha foi gerada com êxito." _
& vbCrLf & "Está em " & sTemp, vbInformation, "ATENÇÃO"
End Sub

Código alterado.

Corriga o que está a vermelho.

Dim sql As String
If IsNull(Me.DataInicial) Or (Me.DataFinal) Or IsNull(Me.Campo) Then Exit Sub
DoCmd.Hourglass True
MinhaDataI = Format((Forms![Frm_ExportarFatDep]![DataInicial]), "mm/dd/yy")
MinhaDataF = Format((Forms![Frm_ExportarFatDep]![DataFinal]), "mm/dd/yy")
CampoC = Forms![Frm_ExportarFatDep]![Campo]

sql = "SELECT Mat_Siape, Data_Vencimento, Nome_Dependente,"
sql = sql & " Data_Nascimento, Dt_Admissão, Apólice,"
sql = sql & " Cap_Segurado, Sexo, CPF,"
sql = sql & " Valor_Dep, Form_Pg_Segurado"
sql = sql & " FROM ExportaExcelDependente"
sql = sql & " WHERE Data_Vencimento >= #" & MinhaDataI & "# AND Data_Vencimento <= #" & MinhaDataF & "# AND form_pg_segurado='" & CampoC & "'"

Muito obrigado pela sua ajuda, este forum e realmente fantastico.