| Ejemplos para acceder a las bases de datos
generadas con el Access 2000, desde el VB5 (también vale para el VB6 o posterior),
pero usando DAO.
El "truco" consiste en agregar la referencia a la librería
adecuada del motor JET, en esta ocasión será: Microsoft DAO 3.6 Object
Library
Por tanto, en el menú de proyecto tendrás que seleccionar "Referencias..."
y de la lista seleccionar la librería de la versión 3.6. Una vez referenciada
el motor adecuado, podremos acceder a las bases creadas con el Access
2000.
El código de ejemplo:
Crea un nuevo proyecto, en Proyecto/Referencias...
selecciona Microsoft DAO 3.6 Object Library, añade 3 controles TextBox
(Text1, un array desde el índice 0 al 2), otro TextBox (Text2), un array
de cuatro botones (cmdMove, con índices desde 0 a 3), un botón para Actualizar
(cmdUpdate), otro para Eliminar registros (cmdDel) y otro para Añadir
nuevos registros (cmdAdd), además una etiqueta (lblStatus) para mostrar
alguna que otra información de lo que estamos haciendo.
Por último, pega este código y... ¡ya está!
Este es el aspecto del formulario:
Option Explicit
Private sBase As String ' Nombre de la base de datos
' Objetos para acceder directamente a la base usando código
Private db As Database
Private rst As Recordset
' Constantes para el movimiento dentro del recordset
Const cPrimero = 0
Const cAnterior = 1
Const cSiguiente = 2
Const cUltimo = 3
Private Sub cmdAdd_Click()
' Añadir un nuevo registro al recordset
Dim i As Long
' Vaciar el contenido de los textboxes
For i = 0 To 2
Text1(i) = " "
Next
Text2 = "Nuevo registro"
On Error Resume Next
' Añadir uno nuevo
With rst
.AddNew
!Nombre = Text1(0)
![e-mail] = Text1(1)
!Comentario = Text1(2)
' Actualizar el contenido
.Update
' Esto es necesario para actualizar el "puntero" del recordset
.Bookmark = .LastModified
Text2.Text = "ID: " & !ID
lblStatus.Caption = " Registro: " & !ID & " (" & .AbsolutePosition + 1 & ")"
End With
Text1(0).SetFocus
Err = 0
End Sub
Private Sub cmdDel_Click()
' Eliminar el registro actual
rst.Delete
On Error Resume Next
' Mover al siguiente registro
rst.Move 1
' Si no puede moverse al siguiente, moverlo al anterior
If Err Then
rst.MovePrevious
End If
' Es necesario mostrar el contenido de los registros
MostrarRegistro
Err = 0
End Sub
Private Sub cmdMove_Click(Index As Integer)
' Moverse por el recordset
On Local Error Resume Next
Err = 0
Select Case Index
Case cPrimero ' Primero
rst.MoveFirst
Case cAnterior ' Anterior
rst.MovePrevious
Case cSiguiente ' Siguiente
rst.MoveNext
Case cUltimo ' Último
rst.MoveLast
End Select
' Mostrar el contenido del reg
istro actual
MostrarRegistro
' Mostrar el mensaje de error,
para comprobación
If Err Then
lblStatus.Caption = " " & Err.Description
Else
' Mostrar el ID del registro y la posición dentro del recordset
lblStatus.Caption = " Registro: " & rst!ID & " (" & rst.AbsolutePosition + 1 & ")"
End If
Err = 0
End Sub
Private Sub cmdUpdate_Click()
' Actualizar el contenido del registro actual
On Error Resume Next
' Entrar en modo de edición
rst.Edit
' Cuando no se liguen los controles, después de introducir los datos,
' es necesario pulsar en este botón
rst!Nombre = Text1(0)
' Como el nombre de este campo tiene signos especiales,
' hay que ponerlo entre corchetes
rst![e-mail] = Text1(1)
rst!Comentario = Text1(2)
' Actualizar el contenido
rst.Update
If Err Then
lblStatus.Caption = " Actualizar: " & Err.Description
Else
lblStatus.Caption = " Registro actualizado"
End If
Err = 0
End Sub
Private Sub Form_Load()
' Asignar el nombre de la base de datos
' (si la aplicación se ejecuta en el directorio raiz, quitar el \)
sBase = App.Path & "\db2000.mdb"
lblStatus.Caption = ""
' Crear los objetos
Set db = OpenDatabase(sBase)
Set rst = db.OpenRecordset("SELECT * FROM Table1")
' Deshabilitar el botón de Actualizar
cmdUpdate.Enabled = False
' Posicionarse en el primer registro
cmdMove_Click cPrimero
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Cerrar las conexiones y deshacerse de las referencias de los objetos
On Error Resume Next
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
Err = 0
Set fDAO = Nothing
End Sub
Private Sub MostrarRegistro()
' Mostrar en las cajas de texto el contenido del registro actual
On Error Resume Next
' Comprobamos que nos hemos movido a un registro existente
If (Not rst.EOF) And (Not rst.BOF) Then
Text2.Text = "ID: " & rst!ID
Text1(0) = rst!Nombre
' Como el nombre de este campo tiene signos especiales,
' hay que ponerlo entre corchetes
Text1(1) = rst![e-mail]
Text1(2) = rst!Comentario
End If
Err = 0
End Sub
Private Sub Text1_Change(Index As Integer)
' Si se modifica el contenido de los textbox, permitir actualizar
cmdUpdate.Enabled = True
End Sub
|
Visual Basic
