Práctica 5 - Agenda

Se requieren dos Formularios: El primero es el Acceso al Sistema y el segundo la Agenda donde se hacen búsquedas, agregar, eliminar, actualizar y refrescar.

Código Fuente de Acceso al Sistema

Option Explicit
   Dim Sesion As Workspace
   Dim DBAgenda As Database 'variable llamada DBAgenda que apuntará al objeto Database 
   Dim RsUsuario As Recordset 'variable llamada RSUsuario que apuntará al objeto RecordSet
   Dim RsContactos As Recordset 'variable llamada RSAgenda que apuntará al objeto RecordSet
   'Para poder abrir la base de datos, necesitamos saber el path en el que se encuentra
   'dicha base de datos, para ello vamos a crea una constante,
   'en la cual tendrás que indicar el path correcto, es decir,
   'el sitio exacto en el que se encuentra la base de datos, en nuestro caso será Agenda.mdb
   Const sPathBD As String = "F:\IUTOMS\Visual Basic\Ejemplos de Visual Basic\DAO\agenda.mdb"
   Dim Error As Integer

Private Sub Form_Load()
    TxtUsuario = ""
    TxtContraseña = ""
    'Se carga la sesion como area de trabajo
    Set Sesion = Workspaces(0)
    ' Se carga la BD Agenda
    Set DBAgenda = Sesion.OpenDatabase(sPathBD)
    ' Se carga la Tabla Usuario
    Set RsUsuario = DBAgenda.OpenRecordset("Usuario", dbOpenTable)
    'define el indice de la tabla usuario
    RsUsuario.Index = "Usuario" 'define el indice de la tabla usuario
End Sub

Private Sub CmdEntrar_Click()
    'Verifica si el campo usuario esta vacio
    If TxtUsuario = "" Then
        MsgBox "Introduzca el Usuario"
        Exit Sub
    End If
    ' Verifica si el campo contraseña esta vacio
    If TxtContraseña = "" Then
        MsgBox "Debe Introducir la contraseña"
        Exit Sub
    End If
    'define el indice para el recordset usuario
    RsUsuario.Index = "Usuario"
    'Busca el usuario por indice
    'el método Seek para buscar un registro en un Recordset de tipo table
    'El Recordset debe tener definido un índice antes de poder utilizar el método Seek.
    ' Seex "=" significa Igual que los valores de clave especificados.
    RsUsuario.Seek "=", TxtUsuario
    'verifica si el recordset esta vacio
    If RsUsuario.NoMatch = True Then
        MsgBox "El Usuario no está en la Base de Datos"
        Error = Error + 1 'Cuenta los intentos de acceso fallidos
        TxtUsuario = ""
        TxtContraseña = ""
        'valida si hay 3 intentos
        If Error = 3 Then
            End
        End If
        Exit Sub
    End If
    'Validación de la contraseña
    If RsUsuario!Contraseña <> TxtContraseña Then
        MsgBox "Contraseña Incorrecta"
        TxtUsuario = ""
        TxtContraseña = ""
        'Cuenta los intentos fallidos
        Error = Error + 1
        
        'valida si hay 3 intentos
        If Error = 3 Then
            MsgBox "Sorry... Bye..."
            End
        End If
        Exit Sub
    End If
    'Compara q la contraseña q esta en la bd sea igual a la q indico el usuario en el Text
    ' Y entra a la Agenda
    If RsUsuario!Contraseña = TxtContraseña Then
        MsgBox "Bienvenido  a la Agenda"
        frmAccesoDatos.Show
    End If
End Sub

Private Sub CmdSalir_Click()
    End
End Sub

Código Fuente de Acceso a Datos

Option Explicit

Private Sub CmdActualizar_Click()
    'Actualiza el Control Data
    Data1.UpdateRecord
    'Se marca al último registro modificado
    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
    Exit Sub
End Sub

Private Sub CmdAdd_Click()
    'Refresca o recarga los datos del Control Data
    Data1.Refresh
    'Añadir un Nuevo Registro
    Data1.Recordset.AddNew
    'Coloca el cursor en el Id_Codigo
    TxtIdContacto.SetFocus
End Sub

Private Sub CmdBorrar_Click()
    'Eliminar el registro actual
    'Se comprueba que haya algún registro activo,
    'para ello se comprueba que no haya pasado del principio o el final del Recordset
    '
    'Comprobar que hay registros, porque si no hay, dará error
    If (Data1.Recordset.EOF Or Data1.Recordset.BOF) Then
        'Avisar que no hay registros
        Data1.Caption = "Ningún Registro Activo"
    Else
        'Eliminar el registro actual
        Data1.Recordset.Delete
        ' Se mueve al primer registro para que los cambios se hagan permanentes
        ' (tambien se puede mover al último registro)
        Data1.Recordset.MoveFirst
    End If
End Sub

Private Sub CmdBuscar_Click()
    'Simplemente llama al procedimiento Buscar
    Buscar
End Sub

Private Sub CmdBuscarSig_Click()
    'Buscar el Siguiente Registro
    BuscarSiguiente
End Sub

Private Sub CmdRefrescar_Click()
    'Refresca o recarga los datos del Control Data
    Data1.Refresh
End Sub

Private Sub CmdSalir_Click()
    End
End Sub

Private Sub Form_Load()
    TxtBuscar = ""
End Sub