Filtrar entre rango de fechas mediante SQL y mostrar en listbox VBA excel (no funciona correctamente)
Necesito de tu conocimiento con una interrogante que te describo a continuación:
- Al cargar el formulario muestro todos los items con varias columnas mediante un listbox de una base en un archivo externo de excel, hasta ahi todo bien.
- Ahora deseo filtrar los datos que muestra el listbox mediante la columna de fecha cuyo codigo pongo a consideracion:
Private Sub CommandButton1_Click() Dim var_fechaDesde, var_fechaHasta As Date var_fechaDesde = Format(txt_fechaDesde, "mm/dd/yyyy") var_fechaHasta = Format(txt_fechaHasta, "mm/dd/yyyy") OPEN_BBDD sql = "select * from [facturas_resumen$] where [fecha emision] >= #" & var_fechaDesde & "# and [fecha emision] <= #" & var_fechaHasta & "# order by [factura] desc" RUN_BBDD If datos.RecordCount = 0 Then Me.lst_facturas.Clear Me.lst_facturas.ForeColor = vbRed Me.lst_facturas.AddItem " NO EXISTE COINCIDENCIAS EN EL SISTEMA" Else Me.lst_facturas.Clear Me.lst_facturas.ForeColor = Default Me.lst_facturas.Column = datos.GetRows Do While Not datos.EOF Me.lst_facturas.AddItem datos.Fields(0) datos.MoveNext Loop End If CLOSE_BBDD End Sub
- El codigo descrito al correrlo no hace lo que deberia hacer, en mi ejemplo ingrese 10 items (5 del mes Octubre y 5 del Noviembre) a veces funciona y la mayoria no. Si pongo asi: desde 01/10/2015 hasta 31/10/2015 me muestra los 10 items cosa que deberia solo mostrar 5 items. Por otra lado cuando ingreso el rango desde 01/11/2015 hasta 19/11/2015 (fecha de hoy dia) me muestra los 5 items correctamente pero si muestro una fecha superior a hoy dia me da muestra todos.
- Espero haberme explicado bien y me puedas ayudar con esta interrogante que nose a que se debe, quizas el error esta en la sentencia SQL pero nose cual es en si o donde.
Desde ya muchas gracias por tu tiempo. Yo te sigo en todo expertos en todas tus respuestas y apelo a tu conocimiento.
1 Respuesta
H o l a:
Te anexo un código que me está funcionando, como no pusiste la conexión, ni el método Open, tuve que agregarlos para probar y me funciona bien:
Private Sub CommandButton1_Click()
'Act.Por.Dante Amor
Dim var_fechaDesde, var_fechaHasta As Date
var_fechaDesde = Format(txt_fechaDesde, "mm/dd/yyyy")
var_fechaHasta = Format(txt_fechaHasta, "mm/dd/yyyy")
'OPEN_BBDD
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
strFile = ThisWorkbook.FullName
'strFile = ThisWorkbook.Path & "\datosx.xlsx"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'
strSQL = "select * from [facturas_resumen] where " & _
"[fecha emision] >= #" & var_fechaDesde & "# and " & _
"[fecha emision] <= #" & var_fechaHasta & "# order by [factura] desc"
'RUN_BBDD
rs.Open strSQL, cn
If rs.RecordCount = 0 Then
Me.lst_facturas.Clear
Me.lst_facturas.ForeColor = vbRed
Me.lst_facturas.AddItem " NO EXISTE COINCIDENCIAS EN EL SISTEMA"
Else
Me.lst_facturas.Clear
Me.lst_facturas.Column = rs.GetRows
'Me.lst_facturas.ForeColor = Default
'Do While Not rs.EOF
' Me.lst_facturas.AddItem rs.Fields(0)
' rs.MoveNext
'Loop
End If
'CLOSE_BBDD
rs.Close
End SubEn esta línea estoy tomando los datos del archivo:
strFile = ThisWorkbook.FullName
Pero puedes poner el nombre del archivo excel externo así:
'strFile = ThisWorkbook.Path & "\datosx.xlsx"
También tuve que quitar el símbolo $ al nombre "facturas_resumen" porque me marca error, por lo demás me lee los datos sin problema.
Ah, otra cosa, también comenté estas líneas:
'Me.lst_facturas.ForeColor = Default
'Do While Not rs.EOF
' Me.lst_facturas. AddItem rs. Fields(0)
' rs. MoveNext
'Loop
Ya que con esta línea se hace la carga completa:
Me.lst_facturas.Column = rs.GetRows
Si quieres te envío mis archivos de prueba. Envía un correo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “” y el título de esta pregunta.
Apreciado Dante
Ya te envíe el correo con las indicaciones en el asunto como me sugeriste.
Quedo muy atento a tu respuesta.
Gracias desde ya.
H o l a:
Te anexo la macro actualizada:
Private Sub CommandButton1_Click()
'Act.Por.Dante Amor
Dim var_fechaDesde As Date, var_fechaHasta As Date
var_fechaDesde = Format(txt_fechaDesde, "mm/dd/yyyy")
var_fechaHasta = Format(txt_fechaHasta, "mm/dd/yyyy")
var_fechaHasta = var_fechaHasta + 1
'OPEN_BBDD
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
'strFile = ThisWorkbook.FullName
strFile = ThisWorkbook.Path & "\base\base.xlsx"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'
strSQL = "select * from [facturas_resumen$] where " & _
"[FECHA EMISION] >= #" & var_fechaDesde & "# and " & _
"[FECHA EMISION] < #" & var_fechaHasta & "# order by [factura] desc"
'RUN_BBDD
rs.Open strSQL, cn
If rs.RecordCount = 0 Then
Me.lst_facturas.Clear
Me.lst_facturas.ForeColor = vbRed
Me.lst_facturas.AddItem " NO EXISTE COINCIDENCIAS EN EL SISTEMA"
Else
Me.lst_facturas.Clear
Me.lst_facturas.Column = rs.GetRows
End If
'CLOSE_BBDD
rs.Close
End Subsal u dos
