Olá pessoal. Tenho um código de pesquisa que funciona PERFEITAMENTE. Aqui está:
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*'"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Empresa, Nome " _
& "FROM dados_empresa ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
No caso acima, ele procura todas as EMPRESAS cadastradas. Ótimo!
Só que estou tentando fazer com que ele procure agora, os FUNCIONÁRIOS cadastrados! Beleza.. sem segredo: Aqui está o código:
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*'"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Func, Nome " _
& "FROM dados_funcionario ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
Só que assim. Tem uma rotina que depois que ele acha a empresa, por exemplo, aparece o nome dela na caixa de texto, você dá dois cliques e ele abre o cadastro da empresa. O problema é, eu quero que ele pesquise os funcionários APENAS da empresa que está CARREGADA (id_Empresa) no form CADASTROS_EMPRESA. Deu pra entender? senão, por exemplo, empresa A tem o funcionario Gil, Marcos e Marcelo. Eu abro o form LOCALIZAR FUNCIONARIO e quando digitar "gi" vai aparecer Girlando, Gilmar, Gil, Gildete. Ao invés de aparecer apenas Gil, porque a empresa aberta só tem esse funcionário que tem o nome iniciado com "gi".
Tentei fazer algo como o código abaixo mas não deu muito certo...
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*' & where Id_Empresa = Forms![Cadastro empresa]"[id_Empresa]"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Func, Nome " _
& "FROM dados_funcionario ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
Eu não sei NADINHA sobre o código de cima.. será que alguém conseguiria me dar uma luz?
Pergunta
Gil Kléber
Olá pessoal. Tenho um código de pesquisa que funciona PERFEITAMENTE. Aqui está:
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*'"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Empresa, Nome " _
& "FROM dados_empresa ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
No caso acima, ele procura todas as EMPRESAS cadastradas. Ótimo!
Só que estou tentando fazer com que ele procure agora, os FUNCIONÁRIOS cadastrados! Beleza.. sem segredo: Aqui está o código:
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*'"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Func, Nome " _
& "FROM dados_funcionario ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
Só que assim. Tem uma rotina que depois que ele acha a empresa, por exemplo, aparece o nome dela na caixa de texto, você dá dois cliques e ele abre o cadastro da empresa. O problema é, eu quero que ele pesquise os funcionários APENAS da empresa que está CARREGADA (id_Empresa) no form CADASTROS_EMPRESA. Deu pra entender? senão, por exemplo, empresa A tem o funcionario Gil, Marcos e Marcelo. Eu abro o form LOCALIZAR FUNCIONARIO e quando digitar "gi" vai aparecer Girlando, Gilmar, Gil, Gildete. Ao invés de aparecer apenas Gil, porque a empresa aberta só tem esse funcionário que tem o nome iniciado com "gi".
Tentei fazer algo como o código abaixo mas não deu muito certo...
Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado
Pesquisa:
mValor = txtPesquisa.Text
If Len(mValor & "") = 0 _
Or Asc(mValor) = 32 Then 'Limpa espaços também.
Call cmdLimpar_Click
Exit Sub
End If
'Na primeira vez, a rotina desviará para o rótulo
'Rs_Fechado, pois o Recordset ainda não foi aberto.
'Na 2ª vez em diante, a rotina prossegue normalmente.
With rs
.Filter = "Nome Like '*" & adhHandleQuotes(mValor, "'") & "*' & where Id_Empresa = Forms![Cadastro empresa]"[id_Empresa]"
Set Rs1 = .OpenRecordset
'Move para último p/ fazer contagem na função PreencheLista
If Rs1.RecordCount <> 0 Then Rs1.MoveLast
lstRetorno.Requery
End With
Fim:
Exit Sub
Rs_Fechado:
Select Case Err
Case 91, 3420 'Ocorre só na primeira vez em que é pesquisado um item.
strSQL = "SELECT ID_Func, Nome " _
& "FROM dados_funcionario ORDER BY Nome"
'Cria um recordset bem rápido, pois é SnapShot.
Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
GoTo Pesquisa
Case 5 'ocorre ao voltar com BackSpace, apagando o texto.
Resume Next
Case Else
MsgBox "Erro nº " & Err & vbCrLf _
& Err.Description, vbCritical, "Erro"
End Select
Resume Fim
End Sub
Eu não sei NADINHA sobre o código de cima.. será que alguém conseguiria me dar uma luz?
Abraços!!!
Link para o comentário
Compartilhar em outros sites
3 respostass a esta questão
Posts Recomendados
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.