Hola foreros, nuevamente apelo a su conocimiento, de antemano gracias por su tiempo y por su ayuda.
El asunto es que tengo un procedimiento que me filtra registros y los inserta en un listview, el problema lo tengo en las opciones del filtrado, en el formulario tengo un Chek, alhacer ckick en este se habilita o deshabilita un combo en el cual tengo los datos de la tabla categorias en formato 001 - Administracion, 002 - Trafico, Etc , lo que pretendo es que si el chek esta en False que me filtre todos los registros y si esta en true me filtre los registros para la categoria seleccionada del combo, he simplificado en este caso por que a demas de opcion por categoria tengo 7 opciones mas por lo que no se me hace facil hacer una sql por que tendria que realizar una combinacion terrible de datos por lo que se me ocurrio lo que les marco en rojo pero no me da error pero tampoco funciona, o sea no me devuelve todos los registros.
Sub Filtrar()
On Error GoTo Hay_err_err
Dim Categoria As Variant
If Me.Check2.Enabled = True Then
Categoria = "*"
end If
If Me.Check2.Enabled = false Then
Categoria = Mid(Me.Combo4,1,3)
end If
Dbpath = App.Path & "\" & DirectorioBase & "\" & Db_A_Name
StrSql = "SELECT * FROM tbl_Empleados WHERE categoria=" & Categoria
Set Db = DBEngine.OpenDatabase(Dbpath, False, False, ";pwd=" & StrPass)
Set Rst = Db.OpenRecordset(StrSql)
While Not Rst.EOF
Set Item = Me.ListView2.ListItems.Add(, , Rst!legajo)
Item.SubItems(1) = Rst!nombres '& ", " & Rst!Apelldos
Rst.MoveNext
Wend
Hay_err_exit:
Rst.Close
Db.Close
Set Rst = Nothing
Set Db = Nothing
Hay_err_err:
Select Case Err.Number
Case 3024
MsgBox "Es imposible encontrar la base de datos. " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la ruta:" & App.Path & "\bases" & " e intente nuevamente", vbInformation + vbOKOnly, "Aviso!"
' Exit Function
Case 3078
MsgBox "Es imposible encontrar la tabla: " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la base de datos" & "Base_Actual.mdb" & "e intente nuevamente", vbInformation + vbOKOnly, "Aviso!"
'Exit Function
End Select
End Sub
Bueno, nuevamente gracias y disculpen si olvido algo es que lo escribo comoforme se me cruzan las palabras.
pues podrias "jugar" con una cadena de texto que vaya formando la consulta, por ejemplo al cargar el form pon el inicio de la sentencia SQL
'variable global en el form
Dim Consulta as String
dim Cons1 as string
dim Cons2 as String
dim Cons3 as string
dim Cons4 as string
Private sub Form_Load()
Consulta = "SELECT * FROM tbl_Empleados WHERE "
end sub
en caso de que deshabilites un check quitas cosas
Private Sub Check1_Click()
if check1.value = 0 then cons1 = ""
End Sub
Private Sub Check2_Click()
if check2.value = 0 then cons2 = ""
End Sub
Private Sub Check3_Click()
if check3.value = 0 then cons3 = ""
End Sub
Private Sub Check4_Click()
if check1.value = 0 then cons4 = ""
End Sub
y en cada Combo le pones le pones cosas
Private sub Combo1_Click()
Cons1 = "categoria = " & mid(combo1, 1, 3)
end sub
Private sub Combo2_Click()
Cons2 = "Otracategoria" & mid(combo2, 1, 3)
end sub
Private sub Combo3_Click()
Cons3 = "Otracategoria" & mid(combo3, 1, 3)
end sub
Private sub Combo4_Click()
Cons4 = "Otracategoria" & mid(combo4, 1, 3)
end sub
y ya en el procedimiento de filtrar pegas todo.
if cons1 <> "" then consulta = consulta & cons1 & " AND "
if cons1 <> "" then consulta = consulta & cons2 & " AND "
if cons1 <> "" then consulta = consulta & cons3 & " AND "
if cons1 <> "" then consulta = consulta & cons4
' Esto es por si la cadena terminara en " AND "
if right(Consulta, 5) = " AND " then consulta = left(Consulta, len(consulta)-5)
consulta = consulta & " ORDER BY uncampo;"
' y ahora si haces la consulta
Dbpath = App.Path & "\" & DirectorioBase & "\" & Db_A_Name
Set Db = DBEngine.OpenDatabase(Dbpath, False, False, ";pwd=" & StrPass)
Set Rst = Db.OpenRecordset(Consulta)
While Not Rst.EOF
Set Item = Me.ListView2.ListItems.Add(, , Rst!legajo)
Item.SubItems(1) = Rst!nombres '& ", " & Rst!Apelldos
Rst.MoveNext
Wend
Hay_err_exit:
Rst.Close
Db.Close
Set Rst = Nothing
Set Db = Nothing
Hay_err_err:
Select Case Err.Number
Case 3024
MsgBox "Es imposible encontrar la base de datos. " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la ruta:" & App.Path & "\bases" & " e intente nuevamente", vbInformation + vbOKOnly, "Aviso!"
' Exit Function
Case 3078
MsgBox "Es imposible encontrar la tabla: " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la base de datos" & "Base_Actual.mdb" & "e intente nuevamente", vbInformation + vbOKOnly, "Aviso!"
'Exit Function
End Select
End Sub