Cómo manejar fechas en consultas Publicado: 09/Jul/2003 |
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 FunctionEsta 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, adLockReadOnlyPero 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 WithPero 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
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 ADO, en referencias tendrás que añadir una a: Microsoft ActiveX Data Objects 2.5 Library
Además de una a ADOX: Microsoft ADO Ext. 2.7 for DDL and Security
(la versión pude ser cualquier otra anterior a la 2.7)
Para usar el ListView tendrás que añadir el componente: Microsoft Windows Common Controls 6.0 (SP6)Nota:
He de aclarar que para mi gusto, este código no está terminado, ya que, por ejemplo, los tipos de datos no están "comprobados", simplemente los he sustituido "a mocho".Además, (y esto es más grave), que con el motor 3.51 (el compatible con Access 97) no he logrado crear un campo Auntonumérico, sin embargo usando el 4.0 si que se crea sin problemas...
Lo mismo es que estoy demasiado "ofuscado", en fin... a ver si con más calma o con la ayuda de alguna alma caritativa lo dejo solucionado...
Nota del 10/Jul/03:
Pues la aparición del alma caritativa no se ha hecho esperar, gracias a Joaquín Delgado Pastor, tenemos la solución.
Y esta consiste en lo siguiente:
-Usar siempre el proveedor Microsoft.Jet.OLEDB.4.0
-Añadir esta cadena a la cadena de conexión:
-Para Access 97: Jet OLEDB:Engine Type=4;
-Para Access 2000: Jet OLEDB:Engine Type=5;
De esta forma se creará correctamente el campo autonumérico y según se seleccione la opción 3.51 o 4.0 se creará una base de datos compatible con Access 97 o Access 2000/XP respectivamente.En el código mostrado están hechas las correcciones correspondientes para usar este nueva forma.
Si quieres, ahora en los dos Options en lugar de indicar el "motor" Jet, se puede indicar si será con formato Access 97 o con formato Access 2000/XP.
En el código incluido en el Zip ya está modificado.
Este es el código completo del ejemplo de ADO (fechasADO.zip 12.8 KB)
El código del formulario para crear la base y los campos, etc.
'------------------------------------------------------------------------------ ' Crear una base de datos ADO (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 sProvider As String 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 i As Long ' Dim tbl As ADOX.Table Dim cat As ADOX.Catalog Dim idx As ADOX.Index Dim col As ADOX.Column ' Dim sProviderDes As String ' 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 ' On Error GoTo 0 ' ' Gracias a Joaquin Delgado Pastor (10/Jul/03), con esto funciona: ' Select Case True Case Me.optVersion(0) 'sProvider = "Microsoft.Jet.OLEDB.3.51" ' sProviderDes = "Jet OLEDB:Engine Type=4;" Case Me.optVersion(1) 'sProvider = "Microsoft.Jet.OLEDB.4.0" sProviderDes = "Jet OLEDB:Engine Type=5;" End Select sProvider = "Microsoft.Jet.OLEDB.4.0" ' ' Crear la base de datos Set cat = New ADOX.Catalog cat.Create "Provider=" & sProvider & ";" & _ "Data Source=" & txtBase & ";" & sProviderDes ' Set cat = New ADOX.Catalog Set tbl = New ADOX.Table ' ' Abrir el catálogo cat.ActiveConnection = _ "Provider=" & sProvider & ";" & _ "Data Source=" & txtBase & ";" ' ' Crear la nueva tabla With tbl .Name = txtTabla.Text ' Crear los campos y añadirlos a la tabla. ' Esto hay que hacerlo antes de añadir la tabla a la colección de tablas Set col = New ADOX.Column With col .Name = "ID" .Type = adInteger ' Autoincrement no existe como propiedad en 3.51 If sProvider <> "Microsoft.Jet.OLEDB.3.51" Then Set .ParentCatalog = cat .Properties("AutoIncrement") = True End If End With .Columns.Append col ' ' Set idx = New ADOX.Index idx.Name = "IDx" idx.PrimaryKey = True idx.Unique = True idx.IndexNulls = adIndexNullsDisallow idx.Columns.Append "ID" .Indexes.Append idx ' ' ' Dependiendo del tipo de proveedor, los datos de cadena serán de un tipo u otro If sProvider = "Microsoft.Jet.OLEDB.3.51" Then ' Para Access 97 .Columns.Append "Nombre", adVarChar, 50 ' Una cadena de 50 caracteres .Columns.Append "FechaTérmino", adDate Else ' Para Access 2000 .Columns.Append "Nombre", adVarWChar, 50 ' Una cadena de 50 caracteres .Columns.Append "FechaTérmino", adDate End If .Columns("Nombre").Attributes = adColNullable ' Permite contener nulos .Columns("FechaTérmino").Attributes = adColNullable End With ' ' Añadir la nueva tabla a la base de datos cat.Tables.Append tbl ' Set tbl = Nothing Set cat = Nothing ' ' 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 Table) '-------------------------------------------------------------------------- ' Inicializar los campos de la tabla especificada '-------------------------------------------------------------------------- Dim Fd As Column 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.Columns 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(.DefinedSize), eTamaño.Tamaño, vbRightJustify) & " " s = s & IIf((.Attributes And adColNullable) = adColNullable, " Sí ", " No ") & " " s = s & IIf((.Attributes And adIndexNullsAllow) = adIndexNullsAllow, " 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 DataTypeEnum.adBigInt s = "adBigInt" Case DataTypeEnum.adBinary s = "adBinary" Case DataTypeEnum.adBoolean s = "adBoolean" Case DataTypeEnum.adChar s = "adChar" Case DataTypeEnum.adVarChar s = "adVarChar" Case DataTypeEnum.adCurrency s = "adCurrency" Case DataTypeEnum.adDate s = "adDate" Case DataTypeEnum.adDecimal s = "adDecimal" Case DataTypeEnum.adDouble s = "adDouble" Case DataTypeEnum.adSingle s = "adSingle" Case DataTypeEnum.adGUID s = "adGUID" Case DataTypeEnum.adInteger s = "adInteger" Case DataTypeEnum.adNumeric s = "adNumeric" Case DataTypeEnum.adLongVarBinary s = "adLongVarBinary" Case DataTypeEnum.adNumeric s = "adNumeric" Case DataTypeEnum.adSingle s = "adSingle" Case DataTypeEnum.adDBTime s = "adDBTime" Case DataTypeEnum.adDBDate s = "adDBDate" Case DataTypeEnum.adVarBinary s = "adVarBinary" Case Else s = "adVarChar" 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 i As Long Dim s As String Dim cat As ADOX.Catalog Dim tTable As ADOX.Table 'Dim col As ADOX.Column ' On Error GoTo ErrAdd ' Set cat = New ADOX.Catalog cat.ActiveConnection = "Provider=" & sProvider & "; Data Source=" & txtBase.Text Set tTable = cat.Tables(txtTabla.Text) ' With Me.cboTipo i = .ItemData(.ListIndex) End With With tTable .Columns.Append txtNombre, i, txtLongitud With .Columns(txtNombre) If Me.chkAllowZeroLength Then .Attributes = adColNullable 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(.DefinedSize), eTamaño.Tamaño, vbRightJustify) & " " s = s & IIf((.Attributes And adColNullable) = adColNullable, " Sí ", " No ") & " " s = s & " " 'IIf(.Required, " Sí ", " No ") List1.AddItem s End With End With ' Set tTable = Nothing Set cat = Nothing ' Exit Sub ' ErrAdd: MsgBox "Error al añadir el campo: " & txtNombre & vbCrLf & _ Err.Number & " " & Err.Description, _ vbExclamation Or vbOKOnly, "Error al borrar campos" End Sub Private Sub cmdConsulta_Click() Load fComprobarFechasADO With fComprobarFechasADO .NombreBase = txtBase .NombreTabla = txtTabla .Provider = sProvider .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 b As Boolean Dim i As Long Dim cat As ADOX.Catalog Dim tTable As ADOX.Table Dim col As ADOX.Column ' ' Set cat = New ADOX.Catalog cat.ActiveConnection = "Provider=" & sProvider & "; Data Source=" & txtBase.Text Set tTable = cat.Tables(txtTabla.Text) ' ' ' Si es un índice, borrarlo de la tabla de índices (08/May/01) On Error Resume Next b = tTable.Indexes(txtNombre).Unique If Err = 0 Then If b = False Then tTable.Indexes.Delete txtNombre Else If MsgBox("¡ATENCION! El campo " & txtNombre & " es un índice único." & vbCrLf & "¿Quieres borrarlo?", vbYesNo Or vbExclamation) = vbYes Then On Error GoTo ErrDel tTable.Indexes.Delete txtNombre End If End If End If Err = 0 On Error GoTo ErrDel tTable.Columns.Delete 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 ' Set tTable = Nothing Set cat = Nothing ' Exit Sub ' ErrDel: MsgBox "Error al borrar el campo: " & txtNombre & vbCrLf & _ Err.Number & " " & Err.Description, _ vbExclamation Or vbOKOnly, "Error al borrar campos" End Sub Private Sub cmdMostrarCampos_Click() ' abrir la tabla señalada por el combo Dim cat As ADOX.Catalog Dim tTable As ADOX.Table ' Set cat = New ADOX.Catalog cat.ActiveConnection = "Provider=" & sProvider & "; Data Source=" & txtBase.Text Set tTable = cat.Tables(txtTabla.Text) ' ReDim sCampos(0) ' mostrarCampos tTable habilitarCampos True ' Set tTable = Nothing Set cat = 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 cnn As ADODB.Connection Dim tRs As ADODB.Recordset ' 'On Error GoTo ErrRellenar On Error GoTo 0 ' ' 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 cnn = New ADODB.Connection cnn.Open "Provider=" & sProvider & "; Data Source=" & txtBase s = "SELECT * FROM " & txtTabla Set tRs = New Recordset tRs.Open s, cnn, adOpenDynamic, adLockOptimistic ' 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.adDate If Rnd > 0.5 Then .Fields(sCampos(k)) = Now + Int(Rnd * cuantosDias) Else .Fields(sCampos(k)) = Now - Int(Rnd * cuantosDias) End If Case DataTypeEnum.adVarChar, DataTypeEnum.adVarWChar .Fields(sCampos(k)) = ajusta(sCampos(k) & " " & i, .Fields(sCampos(k)).DefinedSize, vbLeftJustify) Case DataTypeEnum.adCurrency .Fields(sCampos(k)) = CCur(Rnd * 15000) End Select Next .Update End With Next ' Set tRs = Nothing cnn.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 ' 'txtBase = App.Path & "\PruebaDAO.mdb" txtBase = "PruebaADO.mdb" 'sProvider = "Microsoft.Jet.OLEDB.3.51" ' con el proveedor 4.0 el autoincremento no da error sProvider = "Microsoft.Jet.OLEDB.4.0" ' ' Asignar al combo los tipos de datos a elegir With cboTipo .Clear ' Tipos de datos de DAO y ADO (equivalencias) 'dbBinary adBinary 'dbBoolean adBoolean 'dbByte adUnsignedTinyInt 'dbCurrency adCurrency 'dbDate adDate 'dbDecimal adNumeric 'dbDouble adDouble 'dbGUID adGUID 'dbInteger adSmallInt 'dbLong adInteger 'dbLongBinary adLongVarBinary 'dbMemo adLongVarWChar 'dbSingle adSingle 'dbText adVarWChar .AddItem tipoToString(DataTypeEnum.adVarChar) .ItemData(.NewIndex) = DataTypeEnum.adVarChar .AddItem "adCurrency" .ItemData(.NewIndex) = DataTypeEnum.adCurrency .AddItem "adDate" .ItemData(.NewIndex) = DataTypeEnum.adDate .AddItem "adNumeric" .ItemData(.NewIndex) = DataTypeEnum.adNumeric .AddItem "adDouble" .ItemData(.NewIndex) = DataTypeEnum.adDouble .AddItem "adInteger" .ItemData(.NewIndex) = DataTypeEnum.adInteger .AddItem "adBoolean" .ItemData(.NewIndex) = DataTypeEnum.adBoolean .AddItem "adVarBinary" .ItemData(.NewIndex) = DataTypeEnum.adVarBinary .AddItem "adChar" .ItemData(.NewIndex) = DataTypeEnum.adChar .AddItem "adSingle" .ItemData(.NewIndex) = DataTypeEnum.adSingle .AddItem "adBigInt" .ItemData(.NewIndex) = DataTypeEnum.adBigInt .AddItem "adBinary" .ItemData(.NewIndex) = DataTypeEnum.adBinary .AddItem "adDecimal" .ItemData(.NewIndex) = DataTypeEnum.adDecimal .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 Private Sub optVersion_Click(Index As Integer) If Index = 0 Then sProvider = "Microsoft.Jet.OLEDB.3.51" Else sProvider = "Microsoft.Jet.OLEDB.4.0" End If End Sub
El código del formulario para hacer la consulta y mostrar los datos
'------------------------------------------------------------------------------ ' Prueba de consulta con fechas en base de datos ADO (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 Public Provider As String Private mCuantosDias As Long ' Objetos para acceder directamente a la base usando código Private cnn As ADODB.Connection 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 ' Set cnn = New ADODB.Connection ' cnn.Open "Provider=" & Provider & "; Data Source=" & NombreBase ' fechaActual = Format$(txtFecha, "dd/mm/yyyy") mCuantosDias = txtDias dFin = (fechaActual + mCuantosDias) ' ListView1.ListItems.Clear ' Set tGT = New cGetTimer tGT.StartTimer ' ' en ADO no hace falta indicar el campo FechaTérmino entre corchetes s = "SELECT ID, Nombre, [FechaTérmino] FROM " & NombreTabla & " WHERE [FechaTérmino] >= " & FechaSQL(fechaActual) & " AND [FechaTérmino] <= " & FechaSQL(dFin) & " ORDER BY [FechaTérmino]" Set tRs = New Recordset tRs.Open s, cnn, adOpenForwardOnly, adLockReadOnly 'adLockOptimistic 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 cnn.Close ' tGT.StopTimer lblInfo.Caption = "Tiempo: " & tGT.ElapsedTime & " (" & n & ")" End Sub Private Sub Form_Load() ' Asignar el nombre de la base de datos y el proveedor ' ' para bases de datos Access 97 (con Access 2000/XP no funciona) NombreBase = App.Path & "\PruebaDAO.mdb" Provider = "Microsoft.Jet.OLEDB.3.51" ' ' para bases de datos Access 2000 (también para Access 97, pero va más lento) 'NombreBase = App.Path & "PruebaDAO.mdb" 'sProvider = "Microsoft.Jet.OLEDB.4.0" ' 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