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