necesito manuales de sql server para conectar a vb

walter andres
19 de Octubre del 2003
necesito con mucha urgenci manuales de sql server para conectar con vb POR FAVOR HACERME LLEGAR CUALQUIER MANUAL LO MAS ANTES POSIBLE

hebrt
19 de Octubre del 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:

La función FechaSQL:

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


--------------------------------------------------------------------------------

Ejemplo usando DAO:

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



--------------------------------------------------------------------------------

Ejemplo usando ADO:

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<

luis abarca
19 de Octubre del 2003
busca manuales en www.softdownload.ar.com
sino escribeme y te enviare informacion
bendiciones
desde costa rica

andres
19 de Octubre del 2003
mira yo baje documentacion relativa a lo que buscas pero esta en ingles de la siguiente pagina:

www.vbexplorer.com

especificamente :

Universal Data Access Using
VB Database Programming

tambien encontre alguna referencia en:

www.sqlmax.com