PROGRAMA AGENDA EN VISUAL BASIC

Creamos una base de datos del tipo Microsoft Access 7.0 desde la opción complemento-visualizador de datos y creamos una tabla llamada amigos con los siguientes campos: nombre, primer_apellido, segundo_apellido, dirección, teléfono , aniversario (fecha) y ID_amigo todos tipo texto excepto los dos últimos que son tipo fecha y tipo autonumérico Long .

Se introducen todos los componentes que se ven en el formulario y además un control adodc que se encuentra añadiendo la biblioteca Microsoft DAO OLEDB 6.0

El código del programa seria el siguiente, habiendo previamente conectado el ADODC a la base de datos con la propiedad ConnectionString: Seleccionando el tipo de motor de la base de datos, que en este caso es Microsoft Jet 4.0 y la dirección de la base de datos. Además la propiedad RecordSource donde introducimos una expresión en lenguaje SQL que será (SELECT * FROM amigos) sin los paréntesis, esta intrucción le dice al adodce cual es la consulta que le quiere hacer, seleccionar todos los registros de la tabla amigos.

Private Sub Command1_Click()

Adodc1.Recordset.MoveFirst

End Sub

Private Sub Command2_Click()

Adodc1.Recordset.MovePrevious

If Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst

End Sub

Private Sub Command3_Click()

Adodc1.Recordset.MoveNext

If Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveLast

End Sub

Private Sub Command4_Click()

Adodc1.Recordset.MoveLast

End Sub

Private Sub Command5_Click()

SiDatos

Adodc1.Recordset.AddNew

End Sub

Private Sub Command6_Click()

SiDatos

End Sub

Private Sub Command7_Click()

Dim i As Integer

i = MsgBox("Seguro que quiere borrar el registro? " & Text1.Text, vbOKCancel + vbExclamation, "Borrar Registro")

If i = vbOK Then

Adodc1.Recordset.Delete

Adodc1.Recordset.Update

Else

Adodc1.Recordset.CancelUpdate

End If

Adodc1.Recordset.MovePrevious

If Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst

End Sub

Private Sub Command8_Click()

Dim i As Integer

'puede dar error al intentar introducir un registro vacio

If Text1.Text = "" And Text2.Text = "" And Text3.Text = "" And Text4.Text = "" And Text5.Text = "" And Text6.Text = "" Then

i = MsgBox("Introduzca algún valor diferente de nada en los cuadros de texto, si no se cancelará la actualización", vbOKCancel + vbExclamation, "Cuadros de texto vacios")

Adodc1.Recordset.CancelUpdate

Else

Adodc1.Recordset.Update

End If

NoDatos

End Sub

Private Sub Command9_Click()

On Error Resume Next

Adodc1.Recordset.CancelUpdate

NoDatos

End Sub

Private Sub Form_Load()

NoDatos

End Sub

'Función NoDatos que evita la inserción de Datos

Private Sub NoDatos()

Text1.Enabled = False

Text2.Enabled = False

Text3.Enabled = False

Text4.Enabled = False

Text5.Enabled = False

Text6.Enabled = False

'Botones de navegación por los registros

Command1.Enabled = True

Command2.Enabled = True

Command3.Enabled = True

Command4.Enabled = True

'Botones de inserción, actualización, etc... de la base de datos

Command5.Enabled = True

Command6.Enabled = True

Command7.Visible = True

Command8.Visible = False

Command9.Visible = False

mnuInsertar.Enabled = True

mnuSalir.Enabled = True

mnuBorrar.Enabled = True

End Sub

'Función SiDatos que permite la inserción de Datos

Private Sub SiDatos()

Text1.Enabled = True

Text2.Enabled = True

Text3.Enabled = True

Text4.Enabled = True

Text5.Enabled = True

Text6.Enabled = True

'Botones de navegación por los registros

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

Command4.Enabled = False

'Botones de inserción, actualización, etc... de la base de datos

Command5.Enabled = False

Command6.Enabled = False

Command7.Visible = False

Command8.Visible = True

Command9.Visible = True

mnuInsertar.Enabled = False

mnuSalir.Enabled = False

mnuBorrar.Enabled = False

End Sub

Private Sub mnuRegistro_Click()

End Sub