Lo que vamos a ver aquí es algo bastante simple, será el uso de una fecha en una consulta SQL.
Nota:
Recuerda (o lo aclaro) que una consulta SQL no es una consulta hecha a una base de datos del tipo SQL, sino es una cadena "SELECT" que se usa para obtener los datos de una base de datos, sea del tipo que sea.
El problema con las fechas es que no siempre
funciona como nos gustaría, sobre todo si en la consulta se indica más de una
fecha o varias condiciones sobre una misma fecha.
Por regla general, (al menos yo), usábamos la función DateValue() para
convertir la fecha en un valor de sólo fecha, (no, no es que me esté liando,
bueno, un poco sí, pero es que normalmente un tipo de datos fecha (Date)
suele incluir la fecha y la hora y con DateValue nos quedamos sólo con la
fecha), por la sencilla razón de que esa función la podemos usar tanto
"dentro" de la cadena SQL como fuera de ella para convertir el valor de una
variable en un dato de tipo fecha, dentr ode un rato veremos un ejemplo.
Pero esto no siempre funciona, por tanto lo más recomendable es que los datos
de fechas contenidos en variables, que vayamos a usar en una consulta, la
convirtamos en un dato que no de problemas a confusión al motor de la base de
datos.
Hasta no hace mucho lo que yo hacía (seguramente recomendado por alguien en
algún momento) es convertir la fecha en el formato "americano": #mm/dd/yyyy#,
es decir, poner primero el mes, después el día y a continuación el año. Pero
esto no siempre funcionaba, incluso si cambiaba el carácter / por - para que
la fecha quedara #mm-dd-yyyy#.
Después de mucho probar, la solución que he encontrado es usar el formato de
fechas #yyyy/mm/dd#, es decir empezar desde atrás por el año, el mes y
el día y todo esto siempre encerrado entre un par de almohadillas (#).
Para que me resulte más fácil, me he creado una función que convierte una fecha en el formato indicado, a esta función la he llamado FechaSQL y es la siguiente:
Public Function FechaSQL(ByVal vFecha As String) As String
' Función para convertir una fecha al formato mm/dd/yy ( 7/Ago/97)
' La fecha la convierte al formato: #yyyy/mm/dd# (30/May/01)
'
On Local Error GoTo SQLDateValErr
'
If IsDate(vFecha) Then
' si es una fecha válida, convertirla
FechaSQL = "#" & Format$(vFecha, "yyyy/mm/dd") & "#"
Else
' si no es una fecha válida, devolverlo sin modificar
FechaSQL = vFecha
End If
'
Exit Function
'
SQLDateValErr:
' Si hay error, la fecha por defecto 1-Ene-1980
Err = 0
FechaSQL = "#1980/01/01#"
End Function
Esta función recibe una parámetro que será
una fecha válida (o debería serlo), debido a que es posible que el parámetro
pasado a la función no sea una fecha válida, se comprueba mediante la función
de Visual Basic IsDate(), si es una fecha correcta, la devolvemos en el
formato #yyyy/mm/dd#, en caso de que no sea una fecha válida,
simplemente devolvemos la misma cadena que hemos recibido en el parámetro.
Si se produjera un error, devolveríamos una fecha ficticia.
Ahora veamos cómo hacía yo antes las consultas.
Nota:
Si no quieres tragarte esta batallita, puedes pasar al código "propuesto" usando la función FechaSQL o bien pasar a ver el ejemplo práctico.
Supongamos que tenemos un campo de una tabla que se llama FechaTérmino (con tilde en la e) y quería comprobar todos los datos entre la fecha actual (o la indicada en la variable fechaActual) y un número de días después, (el número de días estará indicado en la variable cuantosDias), lo que hasta hace poco hacía era esto:
Dim s As String
Dim rs As Recordset
Dim dFin As Date
Dim fechaActual As Date
Dim cuantosDias As Long
'
fechaActual = Format$(txtFecha, "dd/mm/yyyy")
cuantosDias = txtDias
dFin = (fechaActual + cuantosDias)
' la cadena de la consulta SQL
s = "SELECT * FROM Tabla WHERE " & _
"DateValue([FechaTérmino]) >= " & DateValue(fechaActual) & _
" AND DateValue([FechaTérmino]) <= " & DateValue(dFin)
' realizar la consulta
' en DAO sería algo así:
' (se supone que Db es del tipo DataBase y ya está instanciada)
Set rs = Db.OpenRecordset(s, dbOpenForwardOnly)
' en ADO sería algo como esto:
' (se supone que cnn es del tipo ADODB.Connection y ya está instanciada)
Set rs = New Recordset
rs.Open s, cnn, adOpenForwardOnly, adLockReadOnly
Pero esto no funciona.
Si quitamos la comparación que hay detrás de AND si funciona, pero
entonces nos devolverá todos los registros (filas) que sean igual o posterior
a la fecha contenida en fechaActual, por tanto tendríamos que hacer
posteriormente un bucle comprobando que las fechas sean inferiores a la fecha
indicada en dFin.
Suponiendo que la cadena de la consulta es:
s = "SELECT * FROM Tabla WHERE DateValue([FechaTérmino]) >= " & DateValue(fechaActual)
El bucle que habría que hacer sería algo así:
With rs
Do While Not .EOF
' ¡en ADO no indicar el campo dentro de corchetes!
If .Fields("[FechaTérmino]") <= DateValue(dFin) Then
'...
End If
.MoveNext
Loop
End With
Pero esto es trabajo doble... ya que...
Usando la función FechaSQL, podemos hacer la consulta de esta forma:
' la cadena de la
consulta SQL, usando FechaSQL
s = "SELECT * FROM Tabla WHERE " & _
"[FechaTérmino] >= " & FechaSQL(fechaActual) & " AND [FechaTérmino]
<= " & FechaSQL(dFin)
Y sólo devolverá las filas que estén entre las dos fechas indicadas.
Si estás usando DAO deberás tener en
cuenta que para acceder al campo FechaTérmino mediante Fields
del recordset, tendrás que usar el nombre de ese campo dentro de corchetes.
Si estás usando ADO no tendrás que usar los corchetes, si lo haces te
dará error.
Nota:
Es posible que me haya estado complicando la vida, pero... así es como lo hacía y como lo hago ahora.
De todas formas, te aclaro que no soy ningún experto en bases de datos... así que... es posible que haya mejores formas de hacer lo que te he comentado y lo que te voy a mostrar, así que... no me regañes si sabes cómo hacerlo mejor, simplemente ¡compártelo! (seguramente ya sabrás cómo...)
Un ejemplo práctico de todo lo dicho.
Ahora veremos un ejemplo completo de cómo
poner todo esto en práctica.
En este ejemplo veremos estas cosillas:
- Crear una base de datos.
- Introducir automáticamente unos campos (ID y FechaTérmino)
- Saber / acceder a los campos de una tabla.
- Añadir / eliminar campos de una tabla.
- Rellenar la tabla con datos ficticios.
- Realizar una consulta desde una fecha indicada y dentro del número de días indicados.
- Recorrer el contenido del recordset y comprobar si hay datos.
- Mostrar el resultado de la consulta en un ListView.
- Calcular el tiempo empleado en la consulta usando la clase cGetTimer.
- Habilitar/ deshabilitar los controles contenidos en un control Frame.
La intención es mostrarte el código relacionado con el acceso a datos tanto para DAO como ADO, por tanto, puedes pulsar en estos links para ver el código de cada una de esas versiones de acceso a datos.
- Ejemplo usando DAO.
- Ejemplo usando ADO (por terminar)
En esos mismos links tienes acceso al código completo.
Aquí te muestro las capturas de los dos formularios usados por los ejemplos.
El formulario para crear la base y los campos con DAO
El formulario para crear la base y los campos
con ADO
El formulario para realizar la consulta
¡Que lo disfrutes!
Nos vemos.
Guillermo
Este es el código usado para todo lo mencionado en la relación anterior, no se incluye el código de la clase cGetTimer, ya que a dicho código puedes acceder usando el link anteriormente indicado.
Para usar DAO, en referencias tendrás que
añadir una a: Microsoft DAO 3.51 Object Library
Para usar el ListView tendrás que añadir el componente: Microsoft Windows
Common Controls 6.0 (SP6)
Este es el código completo del ejemplo de DAO (fechasDAO.zip 12.0 Bytes)
El código del formulario para crear la base y los campos, etc.
'------------------------------------------------------------------------------
' Crear una base de datos DAO (09/Jul/03)
'
' Con el botón de crear la base de datos, se creará una tabla
' con los campos ID, Nombre y FechaTérmino.
' NO BORRAR ESOS CAMPOS para poder probar lo de la consulta.
'
' ©Guillermo 'guille' Som, 2003
'------------------------------------------------------------------------------
Option Explicit
Private sCampos() As String ' Array con los campos en la tabla
'
Private Enum eTamaño
Nombre = 22&
Tipo = 10&
Tamaño = 7&
AlloZeroLength = 7&
Required = 6&
End Enum
'------------------------------------------------------------------------------
' Procedimientos privados (no de eventos)
'------------------------------------------------------------------------------
Private Sub crearBase(ByVal sBase As String)
' Crear la base de datos indicada
'
Dim Db As Database
Dim Fd As Field
Dim Tb As TableDef ' Definir una Tabla
Dim Idx As Index ' Para crear un índice
Dim i As Long
Dim tVersion As DatabaseTypeEnum
'
On Error Resume Next
'If sBase = "" Then Exit Sub
i = Len(Dir$(sBase))
If Err Then i = 1
If i Then
MsgBox "La base de datos indicada ya existe." & vbCrLf & _
"Tendrás que eliminarla antes...", vbCritical
Exit Sub
End If
'
'--------------------------------------------------------------------------
' Crear base de datos, idioma general (dbLangGeneral)
' y para la versión indicada del Jet de Access
'--------------------------------------------------------------------------
Select Case True
Case optVersion(0)
tVersion = dbVersion10
Case optVersion(1)
tVersion = dbVersion11
Case optVersion(2)
tVersion = dbVersion20
Case optVersion(3)
tVersion = dbVersion30
End Select
Set Db = CreateDatabase(sBase, dbLangGeneral, tVersion)
'
' Primero la tabla de las tareas
Set Tb = Db.CreateTableDef(txtTabla.Text)
' Vamos a crear el Campo ID que será un índice
Set Fd = Tb.CreateField("ID", dbLong)
' Ahora vamos a asignar las propiedades de contador, etc.
Fd.Attributes = dbAutoIncrField Or dbUpdatableField Or dbFixedField
Tb.Fields.Append Fd
' El resto de los campos
Set Fd = Tb.CreateField("Nombre", dbText, 50)
Tb.Fields.Append Fd
Set Fd = Tb.CreateField("FechaTérmino", dbDate)
Tb.Fields.Append Fd
'
' Creamos un índice con el ID
Set Idx = New Index
Idx.Name = "PrimaryKey"
Idx.Unique = True
Idx.Primary = True
Idx.Fields = "ID"
' Añadimos el índice a la tabla
Tb.Indexes.Append Idx
' Añadimos la tabla a la base
Db.TableDefs.Append Tb
'
' Cerramos la base
Db.Close
'
MsgBox "Nueva base de datos " & sBase & " creada.", vbInformation
End Sub
Private Function ajusta(ByVal Cadena As String, _
ByVal Ancho As Long, _
Optional Alineado As AlignmentConstants = vbLeftJustify _
) As String
' Ajustar la cadena al ancho especificado
Dim s As String
'
' Alinear según el parámetro Alineado (06/Nov/00)
s = Left$(Cadena, Ancho)
If Alineado = vbLeftJustify Then
s = Left$(s & Space$(Ancho), Ancho)
ElseIf Alineado = vbRightJustify Then
s = Right$(Space$(Ancho) & s, Ancho)
Else
Do While Len(s) < Ancho
s = " " & s & " "
Loop
s = Left$(s, Ancho)
End If
ajusta = s
End Function
Private Sub mostrarCampos(Td As TableDef)
'--------------------------------------------------------------------------
' Inicializar los campos de la tabla especificada
'--------------------------------------------------------------------------
Dim Fd As Field
Dim tIndex As Index
Dim s As String
Dim n As Long
'
'On Local Error Resume Next
'
' recorrer los campos de la tabla
n = -1
'
List1.Clear
s = ajusta("Nombre:", eTamaño.Nombre) & " " & ajusta("Tipo:", eTamaño.Tipo) & " " & ajusta("Tamaño:", eTamaño.Tamaño) & " " & ajusta("CeroLen", eTamaño.AlloZeroLength) & " " & ajusta("Requer", eTamaño.Required)
List1.AddItem s
s = String$(eTamaño.Nombre, "-") & " " & String$(eTamaño.Tipo, "-") & " " & String$(eTamaño.Tamaño, "-") & " " & String$(eTamaño.AlloZeroLength, "-") & " " & String$(eTamaño.Required, "-")
List1.AddItem s
For Each Fd In Td.Fields
s = ""
With Fd
n = n + 1
ReDim Preserve sCampos(n)
sCampos(n) = .Name
'
s = s & ajusta(.Name, eTamaño.Nombre) & " "
' Añadir el "nombre" del tipo
's = s & ajusta(.Type, eTamaño.Tipo) & " "
s = s & ajusta(tipoToString(.Type), eTamaño.Tipo) & " "
s = s & ajusta(CStr(.Size), eTamaño.Tamaño, vbRightJustify) & " "
s = s & IIf(.AllowZeroLength, " Sí ", " No ") & " "
s = s & IIf(.Required, " Sí ", " No ")
List1.AddItem s
End With
Next
'
Err = 0
End Sub
Private Function tipoToString(ByVal elTipo As DataTypeEnum, _
Optional ByVal ConTipo As Boolean = False) As String
' Devuelve una cadena según el tipo de datos (05/Nov/00)
Dim s As String
'
Select Case elTipo
Case dbBigInt
s = "dbBigInt"
Case dbBinary
s = "dbBinary"
Case dbBoolean
s = "dbBoolean"
Case dbByte
s = "dbByte"
Case dbChar
s = "dbChar"
Case dbCurrency
s = "dbCurrency"
Case dbDate
s = "dbDate"
Case dbDecimal
s = "dbDecimal"
Case dbDouble
s = "dbDouble"
Case dbFloat
s = "dbFloat"
Case dbGUID
s = "dbGUID"
Case dbInteger
s = "dbInteger"
Case dbLong
s = "dbLong"
Case dbLongBinary
s = "dbLongBinary"
Case dbMemo
s = "dbMemo"
Case dbNumeric
s = "dbNumeric"
Case dbSingle
s = "dbSingle"
Case dbText
s = "dbText"
Case dbTime
s = "dbTime"
Case dbTimeStamp
s = "dbTimeStamp"
Case dbVarBinary
s = "dbVarBinary"
Case Else
'If ConTipo Then
' s = "Tipo desconocido"
'Else
s = "dbMemo"
'End If
End Select
If ConTipo Then
s = s & " (" & CStr(elTipo) & ")"
End If
tipoToString = s
End Function
Private Sub habilitarCampos(Optional ByVal habilitar As Boolean = True)
' habilitar / deshabilitar los controles contenidos en FrameCampos
Dim tControl As Control
Dim s As String
'
s = FrameCampos.Name
For Each tControl In Controls
' deshabilitar/habilitar sólo los contenidos en el FrameCampos
If tControl.Container.Name = s Then
tControl.Enabled = habilitar
End If
Next
End Sub
'------------------------------------------------------------------------------
Private Sub cmdAdd_Click()
' Añadir el campo indicado a la tabla
Dim tBase As Database
Dim tTableDef As TableDef
Dim tField As Field
Dim i As Long
Dim s As String
'
On Error GoTo ErrAdd
'
Set tBase = OpenDatabase(Me.txtBase)
Set tTableDef = tBase.TableDefs(txtTabla.Text)
'
With Me.cboTipo
i = .ItemData(.ListIndex)
End With
With tTableDef
Set tField = .CreateField(Me.txtNombre, i, Me.txtLongitud)
.Fields.Append tField
With tField '.Fields(txtNombre)
If Me.chkAllowZeroLength Then
.AllowZeroLength = True
Else
.AllowZeroLength = False
End If
If Me.chkRequired Then
.Required = True
Else
.Required = False
End If
' añadirlo a la lista
s = ajusta(.Name, eTamaño.Nombre) & " "
s = s & ajusta(tipoToString(.Type), eTamaño.Tipo) & " "
s = s & ajusta(CStr(.Size), eTamaño.Tamaño, vbRightJustify) & " "
s = s & IIf(.AllowZeroLength, " Sí ", " No ") & " "
s = s & IIf(.Required, " Sí ", " No ")
List1.AddItem s
End With
End With
'
tBase.Close
'
Exit Sub
'
ErrAdd:
MsgBox "Error al añadir el campo: " & txtNombre & vbCrLf & _
Err.Number & " " & Err.Description, _
vbExclamation Or vbOKOnly, "Error al borrar campos"
tBase.Close
End Sub
Private Sub cmdConsulta_Click()
With fComprobarFechasDAO
.NombreBase = txtBase
.NombreTabla = txtTabla
.Show vbModal, Me
End With
End Sub
Private Sub cmdCrearBase_Click()
crearBase txtBase.Text
End Sub
Private Sub cmdDel_Click()
' Eliminar el campo de la tabla
Dim tBase As Database
Dim tTableDef As TableDef
Dim tIndex As Index
Dim b As Boolean
Dim i As Long
'
On Error GoTo 0 'ErrDel
'
Set tBase = OpenDatabase(Me.txtBase)
Set tTableDef = tBase.TableDefs(txtTabla.Text)
' Si es un índice, borrarlo de la tabla de índices (08/May/01)
On Error Resume Next
b = tTableDef.Indexes(Me.txtNombre).Unique
If Err = 0 Then
If b = False Then
tTableDef.Indexes.Delete Me.txtNombre
Else
If MsgBox("¡ATENCION! El campo " & txtNombre & " es un índice único." & vbCrLf & "¿Quieres borrarlo?", vbYesNo Or vbExclamation) = vbYes Then
On Error GoTo ErrDel
tTableDef.Indexes.Delete Me.txtNombre
End If
End If
End If
Err = 0
On Error GoTo ErrDel
tTableDef.Fields.Delete Me.txtNombre
'
' si llegamos aquí, es que se ha borrado
' eliminar el campo de la lista
For i = 0 To List1.ListCount - 1
If InStr(List1.List(i), txtNombre) > 0 Then
List1.RemoveItem i
Exit For
End If
Next
'
tBase.Close
'
Exit Sub
'
ErrDel:
MsgBox "Error al borrar el campo: " & txtNombre & vbCrLf & _
Err.Number & " " & Err.Description, _
vbExclamation Or vbOKOnly, "Error al borrar campos"
tBase.Close
End Sub
Private Sub cmdMostrarCampos_Click()
' abrir la tabla señalada por el combo
Dim Db As Database
Dim Td As TableDef
'
ReDim sCampos(0)
'
Set Db = OpenDatabase(txtBase)
For Each Td In Db.TableDefs
If Td.Name = txtTabla Then
' si es la tabla buscada...
mostrarCampos Td
habilitarCampos True
Exit For
End If
Next
Db.Close
Set Db = Nothing
End Sub
Private Sub cmdRellenarBase_Click()
' rellenar la base de datos con datos ficticios
Dim i As Long, j As Long
Dim k As Long, n As Long
Dim s As String
Dim cuantosDias As Long
Dim tDb As Database
Dim tRs As Recordset
'
On Error GoTo ErrRellenar
'
' asegurarnos de que hemos leido los campos
cmdMostrarCampos_Click
'
n = UBound(sCampos)
If n = 0 Then
MsgBox "La tabla debería tener al menos dos campos", vbInformation
Exit Sub
End If
'
Set tDb = OpenDatabase(txtBase)
s = "SELECT * FROM " & txtTabla
Set tRs = tDb.OpenRecordset(s, dbOpenDynaset)
'
Me.MousePointer = vbHourglass
DoEvents
Randomize
j = txtRegsitros
For i = 1 To j
' crear registros ficticios
cuantosDias = Int(Rnd * 20) + 20
With tRs
.AddNew
For k = 0 To n
' sólo añadir datos en campos de fecha, texto y moneda
Select Case .Fields(sCampos(k)).Type
Case DataTypeEnum.dbDate
If Rnd > 0.5 Then
.Fields(sCampos(k)) = Now + Int(Rnd * cuantosDias)
Else
.Fields(sCampos(k)) = Now - Int(Rnd * cuantosDias)
End If
Case DataTypeEnum.dbText
.Fields(sCampos(k)) = ajusta(sCampos(k) & " " & i, .Fields(sCampos(k)).Size, vbLeftJustify)
Case DataTypeEnum.dbCurrency
.Fields(sCampos(k)) = CCur(Rnd * 15000)
End Select
Next
.Update
End With
Next
'
tRs.Close
tDb.Close
'
Me.MousePointer = vbDefault
DoEvents
MsgBox "Se han añadido " & j & " regsitros a la tabla " & txtTabla, vbInformation
Exit Sub
'
ErrRellenar:
MsgBox "Se ha producido un error:" & vbCrLf & _
Err.Number & " " & Err.Description, vbCritical, "Error al añadir regsitros"
Err = 0
End Sub
Private Sub Form_Load()
Move (Screen.Width - Width) \ 4, 0
'
' Asignar al combo los tipos de datos a elegir
With cboTipo
.Clear
.AddItem "dbText"
.ItemData(.NewIndex) = DataTypeEnum.dbText
.AddItem "dbCurrency"
.ItemData(.NewIndex) = DataTypeEnum.dbCurrency
.AddItem "dbDate"
.ItemData(.NewIndex) = DataTypeEnum.dbDate
.AddItem "dbLong"
.ItemData(.NewIndex) = DataTypeEnum.dbLong
.AddItem "dbDouble"
.ItemData(.NewIndex) = DataTypeEnum.dbDouble
.AddItem "dbInteger"
.ItemData(.NewIndex) = DataTypeEnum.dbInteger
.AddItem "dbBoolean"
.ItemData(.NewIndex) = DataTypeEnum.dbBoolean
.AddItem "dbMemo"
.ItemData(.NewIndex) = DataTypeEnum.dbMemo
.AddItem "dbByte"
.ItemData(.NewIndex) = DataTypeEnum.dbByte
.AddItem "dbChar"
.ItemData(.NewIndex) = DataTypeEnum.dbChar
.AddItem "dbLongBinary"
.ItemData(.NewIndex) = DataTypeEnum.dbLongBinary
.AddItem "dbSingle"
.ItemData(.NewIndex) = DataTypeEnum.dbSingle
.AddItem "dbFloat"
.ItemData(.NewIndex) = DataTypeEnum.dbFloat
.AddItem "dbBigInt"
.ItemData(.NewIndex) = DataTypeEnum.dbBigInt
.AddItem "dbBinary"
.ItemData(.NewIndex) = DataTypeEnum.dbBinary
.AddItem "dbDecimal"
.ItemData(.NewIndex) = DataTypeEnum.dbDecimal
.ListIndex = 0
End With
txtNombre = "Nombre"
txtLongitud = "50"
chkAllowZeroLength.Value = vbChecked
chkRequired.Value = vbUnchecked
' deshabilitar el contenido del Frame1(1)
habilitarCampos False
End Sub
Private Sub List1_Click()
' Mostrar la información del campo seleccionado
Dim i As Long
Dim s As String
'
With List1
i = .ListIndex
If i > 1 Then
s = .List(i)
Me.txtNombre = Trim$(Left$(s, eTamaño.Nombre))
s = LTrim$(Mid$(s, eTamaño.Nombre + 1))
Me.cboTipo.Text = Trim$(Left$(s, eTamaño.Tipo))
s = (Mid$(s, eTamaño.Tipo + 2))
Me.txtLongitud = Trim$(Left$(s, eTamaño.Tamaño))
s = LTrim$(Mid$(s, eTamaño.Tamaño + 1))
If Trim$(Left$(s, eTamaño.AlloZeroLength)) = "Sí" Then
Me.chkAllowZeroLength.Value = vbChecked
Else
Me.chkAllowZeroLength.Value = vbUnchecked
End If
s = LTrim$(Mid$(s, eTamaño.AlloZeroLength + 1))
If Trim$(s) = "Sí" Then
Me.chkRequired.Value = vbChecked
Else
Me.chkRequired.Value = vbUnchecked
End If
End If
End With
End Sub
El código del formulario para hacer la consulta y mostrar los datos
'------------------------------------------------------------------------------
' Prueba de consulta con fechas en base de datos DAO (09/Jul/03)
'
' Los campos que debe tener la tabla de la base indicada serán:
' ID, Nombre y FechaTérmino
'
' ©Guillermo 'guille' Som, 2003
'------------------------------------------------------------------------------
Option Explicit
Public NombreBase As String ' Nombre de la base de datos
Public NombreTabla As String ' El nombre de la tabla
Private mCuantosDias As Long
Private Db As Database
Private Sub cmdProcesar_Click()
' procesar los datos a mostrar
Dim fechaActual As Date
Dim s As String
Dim dFin As Date
Dim tRs As Recordset
Dim tGT As cGetTimer
Dim n As Long
'
On Error Resume Next
Set Db = OpenDatabase(NombreBase)
If Err Then
MsgBox "Error al abrir la base de datos: " & NombreBase & vbCrLf & _
Err.Number & " " & Err.Description
Exit Sub
End If
'
fechaActual = Format$(txtFecha, "dd/mm/yyyy")
mCuantosDias = txtDias
dFin = (fechaActual + mCuantosDias)
'
ListView1.ListItems.Clear
'
Set tGT = New cGetTimer
tGT.StartTimer
'
n = 0
Err.Number = 0
s = "SELECT ID, Nombre, [FechaTérmino] FROM " & NombreTabla & " WHERE [FechaTérmino] >= " & FechaSQL(fechaActual) & " AND [FechaTérmino] <= " & FechaSQL(dFin) & " ORDER BY [FechaTérmino]"
Set tRs = Db.OpenRecordset(s, dbOpenForwardOnly)
If Err Then
MsgBox "Error al abrir el Recordset" & vbCrLf & _
Err.Number & " " & Err.Description
Exit Sub
End If
With tRs
If (.EOF = True) And (.BOF = True) Then
' Si no hay datos...
With ListView1.ListItems.Add(, , "0")
.SubItems(1) = "No hay datos entre las fechas " & Format$(fechaActual, "dd/mm/yyyy")
.SubItems(2) = Format$(dFin, "dd/mm/yyyy")
End With
Else
n = 0
Do While Not .EOF
n = n + 1
With ListView1.ListItems.Add(, , tRs.Fields("ID"))
.SubItems(1) = Trim$(tRs.Fields("Nombre"))
.SubItems(2) = Format$(tRs.Fields("[FechaTérmino]") & "", "dd/mm/yyyy")
End With
.MoveNext
Loop
End If
End With
tRs.Close
Db.Close
'
tGT.StopTimer
lblInfo.Caption = "Tiempo: " & tGT.ElapsedTime & " (" & n & ")"
End Sub
Private Sub Form_Load()
' Asignar el nombre de la base de datos
'NombreBase App.Path & "PruebaDAO.mdb"
'
If Year(Now) > 2003 Then
lblInfo.Caption = "©Guillermo 'guille' Som, 2003-" & Year(Now)
Else
lblInfo.Caption = "©Guillermo 'guille' Som, 2003"
End If
'
mCuantosDias = 10&
txtDias.Text = mCuantosDias
'
' crear las columnas del ListView
' (aunque ya están creadas en tiempo de diseño)
With ListView1
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "ID", 800
.ColumnHeaders.Add , , "Nombre", 3200
.ColumnHeaders.Add , , "Fecha Término", 1400, lvwColumnRight
.GridLines = True
.FullRowSelect = True
.LabelEdit = lvwManual
End With
End Sub
