Ir para conteúdo
Fórum Script Brasil
  • 0

Pesquisa Entre Datas (urgentão)


MaLa

Pergunta

Galera é o seguinte, já procurei e um monte de lugar e ainda não achei a soluçao do meu problema, acho que ainda sou iniciante no VB, pois estou aprendendo tudo sozinho e e eu estou fazendo um tela de pesquisa que ela procura por departamento e por data a tela da minha consulta é mais ou menos assim só para você terem uma ideia

TELA DO PROGRAMA

e o codigo que estou utilizando é esse

MEU FORM LOAD CARREGANDO O CBO DEPARTAMENTO

Private Sub Form_Load()
s$ = "Data    |Hora Inicial |Nome do Cliente                                      |Colaborador      |Departamento          |Atividade                             |Hora Final"
MSFlexGrid1.FormatString = s$
Set rs = CreateObject("ADODB.Recordset")
    With rs
        .Open "select * from [TbDepartamentos] order by [departamentos]", cn, adOpenKeyset, adLockOptimistic
            If .RecordCount = 0 Then
            MsgBox "Não existem cadastrado no sistema.", vbExclamation, "Erro"
                Else
                    CboDepto.Clear
                Do Until rs.EOF
                    CboDepto.AddItem rs("departamentos")
                    rs.MoveNext
                Loop
            End If
        .Close
    End With
End Sub
MEU BOTAO TENTANDO FUNCIONAR....
Private Sub Command1_Click()
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim cmd As ADODB.Command
Dim i As Integer
Dim strSQL As String
Set cmd = New ADODB.Command
    con.Provider = "Microsoft.jet.OLEDB.4.0"
    con.Open "Database\POS.mdb"
    cmd.ActiveConnection = con
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT * FROM [TbAtividade] WHERE [departamento] = '&CboDepto&' AND [data_inicial] >= '&DtInicial&' AND [data_inicial] <= '&DtFinal&'"
    cmd.Execute (quando da erro fica abarelinho essa parte)
    rs.Open cmd
    i = 1
    MSFlexGrid1.Clear
    s$ = "Data          |Hora Inicial |Nome do Cliente                                      |Colaborador     |Departamento          |Atividade                             |Hora Final"
    MSFlexGrid1.FormatString = s$
        If rs.BOF = True And rs.EOF = True Then
            MsgBox "Não existe informação no departamento", vbInformation, "Records not found"
            Exit Sub
        End If
    While Not rs.EOF
       MSFlexGrid1.TextMatrix(i, 0) = rs(0) 'Data
       MSFlexGrid1.TextMatrix(i, 1) = rs(1) 'Hora
       MSFlexGrid1.TextMatrix(i, 2) = rs(2) '
       MSFlexGrid1.TextMatrix(i, 3) = rs(3) '
       MSFlexGrid1.TextMatrix(i, 4) = rs(4) '
       MSFlexGrid1.TextMatrix(i, 5) = rs(5) '
       rs.MoveNext
       i = i + 1
End Sub

E ELE DA UM ERRO ASSIM:

Tipo de dados imcopativel na expressao de criterio

Não sei mais o que eu faço, já tentei de tudo.. eu acho.. me fala o que eu to fazendo de rrado ai

Link para o comentário
Compartilhar em outros sites

6 respostass a esta questão

Posts Recomendados

  • 0

você esta usando bd access, não? então a data tem que estar entre jogo da velha. otra coisa é que você não esta concatenando as variaveis na string, e sim escrevendo-as por extenso. o certo deve ser assim, veja se funciona:

    cmd.CommandText = "SELECT * FROM [TbAtividade] WHERE [departamento] = '" & CboDepto & "' AND [data_inicial] >= #" & DtInicial & "# AND [data_inicial] <= #" & DtFinal & "#"

Link para o comentário
Compartilhar em outros sites

  • 0

Po me ajudem ai.. agora o programa não da erro nem nada mais não filtra os registros com o intervalo de tempo que eu escolho.. se eu tiro os comando das datas ele filtra só por departamento bonitinho.. ai quando eu coloco não filtra nada e não da erro.. só da mensagem que não existe o que a ser filtrado mais isso é do programa que eu coloquei...

Pleeeassseee.. helllpp meee. !

Thanks. !

Danilo

Link para o comentário
Compartilhar em outros sites

  • 0

Ai galera, por desencargo de duvida pra alguém.. eu consegui resolver o meu problema.. . :)

Como eu estava usando o DTPICKER para seleçao de datas... eu fiz assim

Dtpicker1 = data1

Dtpicker2 = data2

na rotina CHANGE do DTPICKER eu coloquei...

Private Sub data1_Change()
    'Verifica se o valor da primeira data é menor que o da segunda e faz o ajuste
    If data1.Value > data2.Value Then
        data1.Value = data2.Value
    End If
End Sub

Private Sub data2_Change()
    'Verifica se o valor da segunda data é maior que o da primeira e faz o ajuste
    If data2.Value < data1.Value Then
        data2.Value = data1.Value
    End If
e depois na rotina do botão pesquisar eu dei apenas um select organizando aas datas
"SELECT * FROM [TbAtividade] WHERE [nome_cliente] = '" & CboEmpresa & "' ORDER BY [data_inicial]"
End Sub

Valeu galera...

Obrigaduuu

qualquer coisa posta ai.. =)

Link para o comentário
Compartilhar em outros sites

  • 0

bom que conseguiu...

mas se não me falha a memória dessa forma também poderia dar certo...

cmd.CommandText = "SELECT * FROM [TbAtividade] WHERE [departamento] = '" & CboDepto & "' AND [data_inicial] BETWEEN #" & DtInicial & "# AND [data_inicial] #" & DtFinal & "#"

Abraço..

Link para o comentário
Compartilhar em outros sites

  • 0

Private Sub data1_Change()
    'Verifica se o valor da primeira data é menor que o da segunda e faz o ajuste
    If data1.Value > data2.Value Then
        data1.Value = data2.Value
    End If
End Sub

Private Sub data2_Change()
    'Verifica se o valor da segunda data é maior que o da primeira e faz o ajuste
    If data2.Value < data1.Value Then
        data2.Value = data1.Value
    End If
"SELECT * FROM [TbAtividade] WHERE [nome_cliente] = '" & CboEmpresa & "' ORDER BY [data_inicial]"
End Sub
Galera.. estranho.. por incrivel que paressa.. meu programa parou de funcionar as datas... não sei o que aconteceu.. sera que a lguem pode me ajudar, vou colcoar aqui todo o meu codigo do formulario pra alguém me da uma luz.. pensei que tinha resolvido e não resolvi nada.. :D __________________________________________________________________________________
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Const HELP_CONTENTS = &H3&
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long

Private Sub CmdCancelar_Click()
Unload Me
End Sub

Private Sub CmdImprimir_Click()
'No evento desejado:
Dim sCaminho As String
Dim objAccess As Access.Application
'Cria uma instância do Access
Set objAccess = New Access.Application
'Caminho do arquivo de banco de dados
sCaminho = App.Path & "Database\POS.mdb"
If Right$(App.Path, 1) = "\" Then
    sCaminho = App.Path & "POS.mdb"
End If
With objAccess
  .Visible = False 'O Access firará invisível
  .OpenCurrentDatabase filepath:=sCaminho
  .DoCmd.OpenReport "RelCol", acViewNormal
End With
 Set objAccess = Nothing
End Sub

Private Sub data1_Change()
    'Verifica se o valor da primeira data é menor que o da segunda e faz o ajuste
    If data1.Value > data2.Value Then
        data1.Value = data2.Value
    End If
End Sub

Private Sub data2_Change()
    'Verifica se o valor da segunda data é maior que o da primeira e faz o ajuste
    If data2.Value < data1.Value Then
        data2.Value = data1.Value
    End If
End Sub

Private Sub Form_Load()
s$ = "Data    |Hora Inicial |Nome do Cliente                                      |Colaborador      |Departamento          |Atividade                             |Hora Final"
MSFlexGrid1.FormatString = s$
Set rs = CreateObject("ADODB.Recordset")
    With rs
        .Open "select * from [User] order by [User Name]", cn, adOpenKeyset, adLockOptimistic
            If .RecordCount = 0 Then
            MsgBox "Não existem cadastrado no sistema.", vbExclamation, "Erro"
                Else
                    CboCol.Clear
                Do Until rs.EOF
                    CboCol.AddItem rs("User Name")
                    rs.MoveNext
                Loop
            End If
        .Close
    End With
End Sub

Private Sub Command1_Click()
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim cmd As ADODB.Command
Dim i As Integer
Dim strSQL As String
Set cmd = New ADODB.Command
    con.Provider = "Microsoft.jet.OLEDB.4.0"
    con.Open "Database\POS.mdb"
    cmd.ActiveConnection = con
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT * FROM [TbAtividade] WHERE [nome_colaborador] = '" & CboCol & "' ORDER BY [data_inicial]"
    rs.Open cmd
    i = 1
    MSFlexGrid1.Clear
    s$ = "Data          |Hora Inicial |Nome do Cliente                                      |Colaborador     |Departamento          |Atividade                             |Hora Final  "
    MSFlexGrid1.FormatString = s$
        If rs.BOF = True And rs.EOF = True Then
            MsgBox "Não existe cadastro para essa empresa...", vbInformation, "Records not found"
            Exit Sub
        End If
    While Not rs.EOF
       MSFlexGrid1.TextMatrix(i, 0) = rs(0) 'Data
       MSFlexGrid1.TextMatrix(i, 1) = rs(1) 'Hora Inicial
       MSFlexGrid1.TextMatrix(i, 2) = rs(2) 'Nome do Cliente
       MSFlexGrid1.TextMatrix(i, 3) = rs(3) 'Colaborados
       MSFlexGrid1.TextMatrix(i, 4) = rs(4) 'Departamento
       MSFlexGrid1.TextMatrix(i, 5) = rs(5) 'Atividade
       MSFlexGrid1.TextMatrix(i, 6) = rs(6) 'Hora Final
       rs.MoveNext
       i = i + 1
    Wend
Record_not_found_err:
    If Err.Number = -2147217900 Then
        MsgBox "Enter Cust ID Preceded by character like '>', '<' or '='.", vbInformation, "Error"
        Text1.SetFocus
        Exit Sub
    End If
End Sub

Lembrando que o que eu gostaria de fazer, é uma pesquisa com intervalo de datas, selecionado pelo DTPICKER... conforme a telinha do programa no link la em cima.. =D

Galera. me da um help urgente ai

Vlwwwww

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...