Lectura de archivos de Access

El siguiente código muestra como leer un archivo Access, tenga en cuenta lo siguiente:

1. Nombre del archivo Access : NWIND.MDB
2. El archivo NWIND.MDB se encuentra localizado en el mismo directorio de la aplicación
3. Es necesario crear una Referencia para hacer uso de los objetos Connection y Recordset
   • Seleccionar del menú principal Project » References
   • Seleccionar Microsoft ActiveX Data Objects 2.0 Library
4. Los controles a utilizar son:
   • TextBox txtProductId
   • TextBox txtProductName
   • TextBox txtUnitPrice
   • CommandButton cmdConectar
   • CommandButton cmdConsulta
   • CommandButton cmdFirst
   • CommandButton cmdAnterior
   • CommandButton cmdSiguiente
   • CommandButton cmdLast
   • StatusBar sbMsg

   Option Explicit
Dim conexion As Connection
Dim rsConexion As Recordset

Private Sub cmdConectar_Click()
On Error GoTo miManejadorErr
Set conexion = New Connection
conexion.Provider = "Microsoft.Jet.OLEDB.4.0"
conexion.ConnectionString = "Data Source = NWIND.MDB"
conexion.CursorLocation = adUseClient
conexion.Open
sbMsg.SimpleText = "Conectado a la fuente de datos"
miManejadorErr:
If Err.Number > 0 Then
Dim strErr
strErr = strErr & "Description : " & Err.Description & Chr(13)
strErr = strErr & "HelpContext : " & Err.HelpContext & Chr(13)
strErr = strErr & "Number : " & Err.Number & Chr(13)
strErr = strErr & "Source : " & Err.Source & Chr(13)
sbMsg.SimpleText = strErr
Resume Next
End If
End Sub

Private Sub cmdConsulta_Click()
On Error GoTo miManejadorErr
Dim comProd As Command
Set comProd = New Command
comProd.ActiveConnection = conexion
comProd.CommandText = "Select * from Products"
Set rsConexion = comProd.Execute
txtProductId.Text = rsConexion!productid
txtProductName.Text = rsConexion!ProductName
txtUnitPrice.Text = rsConexion!UnitPrice
sbMsg.SimpleText = "Consultando..."

miManejadorErr:
If Err.Number > 0 Then
Dim strErr
strErr = strErr & "Description : " & Err.Description & Chr(13)
strErr = strErr & "HelpContext : " & Err.HelpContext & Chr(13)
strErr = strErr & "Number : " & Err.Number & Chr(13)
strErr = strErr & "Source : " & Err.Source & Chr(13)
MsgBox strErr
Resume Next
End If
End Sub

Private Sub cmdDesconectar_Click()
On Error GoTo miManejadorErr
conexion.Close
Set conexion = Nothing
sbMsg.SimpleText = "Desconectado de la fuente de datos"
miManejadorErr:
If Err.Number > 0 Then
Dim strErr
strErr = strErr & "Description : " & Err.Description & Chr(13)
strErr = strErr & "HelpContext : " & Err.HelpContext & Chr(13)
strErr = strErr & "Number : " & Err.Number & Chr(13)
strErr = strErr & "Source : " & Err.Source & Chr(13)
MsgBox strErr
Resume Next
End If
End Sub

Private Sub cmdAnterior_Click()
If rsConexion.AbsolutePosition = 1 Then
sbMsg.SimpleText = "No hay registros anteriores"
Else
rsConexion.MovePrevious
txtProductId.Text = rsConexion!productid
txtProductName.Text = rsConexion!ProductName
txtUnitPrice.Text = rsConexion!UnitPrice
sbMsg.SimpleText = "Registro número : " & rsConexion.AbsolutePosition
End If
End Sub
Private Sub cmdFirst_Click()
rsConexion.MoveFirst
txtProductId.Text = rsConexion!productid
txtProductName.Text = rsConexion!ProductName
txtUnitPrice.Text = rsConexion!UnitPrice
End Sub
Private Sub cmdLast_Click()
rsConexion.MoveLast
txtProductId.Text = rsConexion!productid
txtProductName.Text = rsConexion!ProductName
txtUnitPrice.Text = rsConexion!UnitPrice
End Sub

Private Sub cmdSiguiente_Click()
If rsConexion.AbsolutePosition = rsConexion.RecordCount Then
sbMsg.SimpleText = "No hay más registros"
Else
rsConexion.MoveNext
txtProductId.Text = rsConexion!productid
txtProductName.Text = rsConexion!ProductName
txtUnitPrice.Text = rsConexion!UnitPrice
End If
End Sub

Directorio Web
Mitote.com.mx :: Directorio web