Busca por data não esta funcionando

[RSoaeres]

Tenho uma planilha excel que usa banco access e macros vb, tenho uma busca onde não esta respeitando as datas informadas, e não estou conseguindo achar o problema, alguém consegue identificar o erro?

Private Sub CommandButtonOK_Click()

Dim vStatus As String

Dim strSQL As String

Dim vDe As Date

Dim vAte As Date

Dim i As Long

Dim k As Long

Dim status As String

Dim strSQL1 As String

Dim strSQL2 As String

Dim lista As ADODB.Recordset

Dim vCabecalho As String

Dim vRegioes As String

Dim vSegmento As String

strSQL1 = ""

Select Case True

Case OptionButtonPipeline

vCabecalho = "PIPELINE TRADE - "

vStatus = "LIKE 'EM PIPELINE'"

'PIPELINE

strSQL = "SELECT Cotacao.Index, IIf([Cotacao].[Emenda]<>0 And [Cotacao].[Emenda]<[Cotacao].[index], "

strSQL = strSQL & "'EMENDA: '+[Clientes].[Razao],[Clientes].[Razao]) AS Empresa, Clientes.Segmento, Cotacao.Regional, "

strSQL = strSQL & "Cotacao.TradeSales, Cotacao.Produto, Cotacao.Moeda, Cotacao.Valor, (Cotacao.Valor * Cotacao.Conversao) As Valor_USD,Comissao.Receita, "

strSQL = strSQL & "iif(Comissao.Tipo='Fixo', Format(Comissao.Valor, 'Standard'), "

strSQL = strSQL & "iif(Comissao.Periodo='Flat', Comissao.Valor & ' %flat', "

strSQL = strSQL & "iif(Comissao.Periodo='Ao Mês', Comissao.Valor & ' %a.m.', "

strSQL = strSQL & "iif(Comissao.Periodo='Ao Trimestre', Comissao.Valor & ' %a.t.', Comissao.Valor & ' %a.a.')))), "

strSQL = strSQL & "CDbl(Format([cotacao].[ProbConversao],'0.0')) AS ProbConversao, Cotacao.SubStatus, Status.Cotacao "

strSQL = strSQL & "FROM ((Cotacao LEFT JOIN Status ON Cotacao.Index = Status.RefNumber) "

strSQL = strSQL & "LEFT JOIN Clientes ON Cotacao.CNPJ = Clientes.CNPJ) "

strSQL = strSQL & "LEFT JOIN Comissao ON Cotacao.Index = Comissao.RefNumber "

strSQL = strSQL & "WHERE "

Case OptionButtonPerdidos

vCabecalho = "LOSS TRADE - "

vStatus = "LIKE 'PERDIDO'"

'PERDIDO

strSQL = "SELECT Cotacao.Index, IIf([Cotacao].[Emenda]<>0 And [Cotacao].[Emenda]<[Cotacao].[index], "

strSQL = strSQL & "'EMENDA: '+[Clientes].[Razao],[Clientes].[Razao]) AS Empresa, Clientes.Segmento, Cotacao.Regional, "

strSQL = strSQL & "Cotacao.TradeSales, Cotacao.Produto, Cotacao.Moeda, Cotacao.Valor, (Cotacao.Valor * Cotacao.Conversao) As Valor_USD, Comissao.Receita, "

strSQL = strSQL & "iif(Comissao.Tipo='Fixo', Format(Comissao.Valor, 'Standard'), "

strSQL = strSQL & "iif(Comissao.Periodo='Flat', Comissao.Valor & ' %flat', "

strSQL = strSQL & "iif(Comissao.Periodo='Ao Mês', Comissao.Valor & ' %a.m.', "

strSQL = strSQL & "iif(Comissao.Periodo='Ao Trimestre', Comissao.Valor & ' %a.t.', Comissao.Valor & ' %a.a.')))), "

strSQL = strSQL & "CDbl(Format([cotacao].[ProbConversao],'0.0')) AS ProbConversao, iif([cotacao].[motivo]='Outro',[cotacao].[ObservacaoPerdidoOutro],''),Cotacao.Motivo, Status.Cotacao, Status.Finalizacao"

strSQL = strSQL & " FROM ((Cotacao LEFT JOIN Status ON Cotacao.Index = Status.RefNumber) "

strSQL = strSQL & "LEFT JOIN Clientes ON Cotacao.CNPJ = Clientes.CNPJ) "

strSQL = strSQL & "LEFT JOIN Comissao ON Cotacao.Index = Comissao.RefNumber "

strSQL = strSQL & "WHERE "

End Select

strSQL1 = "(status.fase " & vStatus & ")"

If OptionButtonPerdidos.Value = True Then

If TextBoxDe.Value <> Empty Then

If IsDate(TextBoxDe.Value) Then

vDe = TextBoxDe.Value

Else

MsgBox "Data DE em formato inválido."

Exit Sub

**MOBILE CODE**

Else

vDe = "01/01/" & Year(VBA.Date)

**MOBILE CODE**

If TextBoxAte.Value <> Empty Then

If IsDate(TextBoxAte.Value) Then

vAte = TextBoxAte.Value

Else

MsgBox "Data Até em formato inválido."

Exit Sub

**MOBILE CODE**

Else

vAte = VBA.Date

**MOBILE CODE**

strSQL1 = strSQL1 & " AND (Status.Cotacao >= #" & vDe & "# and Status.Cotacao <=#" & vAte & "#)"

**MOBILE CODE**

strSQL2 = ""

vRegioes = ""

k = ListBoxRegionais.ListCount - 1

For i = 0 To k

If ListBoxRegionais.Selected(i) = True Then

If ListBoxRegionais.List(i) = "All" Then

vRegioes = " All - "

strSQL2 = ""

i = k

Else

vRegioes = vRegioes & ListBoxRegionais.List(i) & " - "

strSQL2 = strSQL2 & "'" & ListBoxRegionais.List(i) & "',"

**MOBILE CODE**

**MOBILE CODE**

Next i

If vRegioes <> Empty Then

vRegioes = "Região(ões): " & VBA.Left(vRegioes, Len(vRegioes) - 2)

Else

vRegioes = "Região(ões): All "

**MOBILE CODE**

If strSQL2 <> Empty Then

strSQL2 = VBA.Left(strSQL2, Len(strSQL2) - 1)

strSQL1 = strSQL1 & " And (Cotacao.Regional in (" & strSQL2 & "))"

**MOBILE CODE**

strSQL2 = ""

vSegmento = ""

k = ListBoxSegmento.ListCount - 1

For i = 0 To k

If ListBoxSegmento.Selected(i) = True Then

If ListBoxSegmento.List(i) = "All" Then

vSegmento = " All - "

strSQL2 = ""

i = k

Else

vSegmento = vSegmento & ListBoxSegmento.List(i) & " - "

strSQL2 = strSQL2 & "'" & ListBoxSegmento.List(i) & "',"

**MOBILE CODE**

**MOBILE CODE**

Next i

If vSegmento <> Empty Then

vSegmento = "Segmento(s): " & VBA.Left(vSegmento, Len(vSegmento) - 2)

Else

vSegmento = "Segmento(s): All "

**MOBILE CODE**

If strSQL2 <> Empty Then

strSQL2 = VBA.Left(strSQL2, Len(strSQL2) - 1)

strSQL1 = strSQL1 & " And (Clientes.Segmento in (" & strSQL2 & "))"

**MOBILE CODE**

MsgBox vDe

MsgBox vAte

strSQL = strSQL & "(" & strSQL1 & ") Order by Cotacao.Regional, Cotacao.Valor "

Set lista = BuscaSQL(strSQL)

vCabecalho = vCabecalho & vRegioes & "-" & vSegmento & " Período de " & vDe & " até " & vAte

ThisWorkbook.Sheets("Relatorio").Select

ThisWorkbook.Sheets("Relatorio").Cells.Clear

ThisWorkbook.Sheets("Relatorio").Cells(3, 1).CopyFromRecordset lista

lista.Close

Set lista = Nothing

FormatarRelatorio (vStatus)

FormatarImpressao (vCabecalho)

CriarSubTotal

FormatarTotal

Unload Me

End Sub

[JoséA]

Há algo aquí: http://www.tomasvasquez.com.br/forum/viewt...f=22&t=1594