PROGRAMA DE CONTROL DE BASE DE DATOS A PARTIR DE UNA CONEXIÓN Y UN RECORDSET

PROGRAMA DE CONTROL DE BASE DE DATOS A PARTIR DE UNA CONEXIÓN Y UN RECORDSET

Creamos un formulario a partir de un control conexión y un control recordset

Proyecto comprimido con winrar: descargar

El código comentado del programa és el siguiente:

Dim conexion 'DECLARO CONEXIÓN PERO NO LE DOY NINGÚN TIPO

Dim RS ' DECLARO RS (RECORDSET) PERO NO LE DOY NINGÚN TIPO

Dim consulta As String 'DECLARO LA CONSULTA COMO UNA CADENA DE CARACTERES

Dim conectado As Boolean 'DECLARO LA VARIABLE BOOLEANA CONECTADO PARA CONTROLAR LOS MOMENTOS

Dim insertar As Boolean 'DECLARO UNA VARIABLE INSERTAR PARA DISTINGUIRLA DE ACTUALIZAR EN EL BOTÓN ACEPTAR

Dim i, contreg, regact, VR, ID As Integer

'FUNCIÓN INICIAL DEL PROGRAMA

Private Sub Form_Load()

'INICIALIZO LAS VARIABLES

conectado = False

insertar = False

'INICIALIZO LOS CONTROLES

Command1.Visible = True

Command2.Visible = False

'LLAMO A LA FUNCION NO DATOS PARA DESHABILITAR LOS CONTROLES

nodatos

End Sub

'BOTONES DE CONEXIÓN A LA BASE DE DATOS

Private Sub Command1_Click()

'**** BOTON DE CONEXION A LA BASE DE DATOS ****

'CONTROLO LOS BOTONES

Command2.Visible = True

Command1.Visible = False

'CREAMOS LA CONEXIÓN Y ABRIMOS LA CONEXIÓN A LA BASE DE DATOS

Set conexion = CreateObject("ADODB.connection")

conexion.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ= " & App.Path & "\prueba.mdb")

Label1.Caption = "CONECTADO"

Label1.BackColor = vbGreen

conectado = True

End Sub

Private Sub Command2_Click()

'**********BOTÓN DE DESCONEXION A LA BASE DE DATOS

Command1.Visible = True

Command2.Visible = False

conexion.Close

Label1.Caption = "DESCONECTADO"

Label1.BackColor = vbRed

conectado = False

'LIMPIO LOS CUADROS DE TEXTO PARA PODER INTRODUCIR NUEVOS DATOS

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

End Sub

'BOTÓN DE SELECCIÓN DE DATOS DE LA BASE DE DATOS

Private Sub Command3_Click()

'**********BOTÓN DE CONSULTA DE SELECCIÓN

'SI ESTAMOS CONECTADOS A LA BASE DE DATOS ENTONCESS

If conectado Then

'GENERAMOS LA CONSULTA DE SELECCIÓN

consulta = "SELECT * FROM PERSONAS"

'EJECUTAMOS LA CONSULTA DE SELECCIÓN

Set RS = conexion.EXECUTE(consulta)

'CONTAMOS EL NUMERO DE REGISTROS QUE TIENE LA CONSULTA

contarregistros

'VAMOS AL PRIMERO

RS.movefirst

'ESTABLECEMOS COMO REGISTRO ACTUAL EL 1

regact = 1

'VISUALIZAMOS EL REGISTRO ACTUAL

verregistro

Else

'SI NO ESTAMOS CONECTADOS, AVISAMOS PARA CONECTAR A LA BASE DE DATOS

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

'FUNCION CONTAR REGISTROS

Private Sub contarregistros()

'**********FUNCIÓN CONTADOR DE REGISTROS

'INICIALIZO EL CONTADOR DE REGISTROS

contreg = 0

regact = 1

'RECORRO UN NÚMRO GRANDE DE REGISTROS (POR EJEMPLO 1000)

For i = 1 To 1000

regact = i - 1

Label2.Caption = contreg & " - " & regact

'SI LLEGAMOS AL FINAL DE FICHERO ENTONCES SALIMOS DE LA FUNCIÓN CONTADOR

If RS.EOF Then Exit Sub

RS.movenext

contreg = contreg + 1

Next

End Sub

'FUNCION VER REGISTRO EN LA PANTALLA

Private Sub verregistro()

'**********FUNCIÓN PARA VISUALIZAR UN REGISTRO DETERMINADO

If RS.EOF Then RS.movefirst: regact = 1

'VISUALIZAMOS EN LOS CUADROS DE TEXTO LOS VALORES DE LOS CAMPOS CORRESPONDIENTES

Text1.Text = RS(0) ' CAMPO ID

Text2.Text = RS(1) ' CAMPO NOMBRE

Text3.Text = RS(2) ' CAMPO APELLIDO1

Text4.Text = RS(3) ' CAMPO APELLIDO2

Text5.Text = RS(4) 'CAMPO EDAD

Label2.Caption = contreg & "/" & regact

End Sub

'BOTONES ACEPTAR Y CANCELAR

Private Sub Command11_Click()

'BOTÓN ACEPTAR

If conectado Then

If insertar Then

'INSERTAMOS LOS DATOS

consulta = "INSERT INTO PERSONAS (NOMBRE,APELLIDO1,APELLIDO2,EDAD) VALUES(" _

& "'" & Text2.Text & "'" & "," _

& "'" & Text3.Text & "'" & "," _

& "'" & Text4.Text & "'" & "," _

& CInt(Text5.Text) & ")"

contreg = contreg + 1

Else

'BOTÓN CANCELAR

consulta = "UPDATE PERSONAS SET NOMBRE=" & "'" & Text2.Text & "'" & "," _

& " APELLIDO1=" & "'" & Text3.Text & "'" & "," _

& " APELLIDO2=" & "'" & Text4.Text & "'" & "," _

& " EDAD=" & CInt(Text5.Text) & " WHERE ID=" & ID

End If

'EJECUTAMOS LA CONSULTA

Set RS = conexion.EXECUTE(consulta)

Command1_Click ' LLAMO A LA CONEXION

Command3_Click ' LLAMO A LA SELECCIÓN

Command10_Click 'VAMOS AL ÚLTIMO REGISTRO

nodatos

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

Private Sub Command12_Click()

'BOTÓN CANCELAR

Command8_Click

nodatos

End Sub

Private Sub Command4_Click()

'BOTÓN INSERTAR REGISTRO

insertar = True

sidatos

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

Private Sub Command5_Click()

'BOTÓN EDITAR REGISTRO

ID = RS(0)

insertar = False

sidatos

End Sub

Private Sub Command6_Click()

If conectado Then

'BORRRAR UN REGISTRO

If MsgBox("¿Seguro que quiere borrar el registro?", vbOKCancel, "Borrar registro") = vbOK Then

ID = RS(0)

consulta = "DELETE * FROM PERSONAS WHERE ID=" & ID

Set RS = conexion.EXECUTE(consulta)

contreg = contreg + 1

Command1_Click ' LLAMO A LA CONEXION

Command3_Click ' LLAMO A LA SELECCIÓN

Command10_Click 'VAMOS AL ÚLTIMO REGISTRO

nodatos

End If

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

Private Sub Command7_Click()

'**********CONEXIÓN DE NAVEGACIÓN I CONEXIÓN AL PRIMER REGISTRO DE LA BASE

'**********DE DATOS

If conectado Then

regact = 1

RS.movefirst

verregistro

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

Private Sub Command10_Click()

' **********BOTÓN DE NAVEGACIÓN AL ÚLTIMO REGISTRO

If conectado Then

'RS.movelast NO SE ADMITE LA RECUPERACIÓN HACIA ATRAS

For i = 1 To contreg - regact: RS.movenext: Next

regact = contreg

verregistro

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

Private Sub Command8_Click()

'**********BOTÓN PARA IR AL REGISTRO ANTERIOR DE LA CONSULTA

If conectado Then

regact = regact - 1

If regact < 1 Then regact = contreg

For i = 1 To (contreg - 1)

RS.movenext

If RS.EOF Then RS.movefirst

Next

verregistro

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

Private Sub Command9_Click()

'**********BOTÓN DE NAVEGACIÓN PARA IR AL REGISTRO SIGUIENTE

If conectado Then

RS.movenext

regact = regact + 1

verregistro

Else

MsgBox "POR FAVOR CONÉCTESE PRIMERO A LA BASE DE DATOS"

End If

End Sub

'FUNCIONES SIDATOS Y NODATOS PARA BLOQUEAR O NO EL FORMULARIO

Private Sub nodatos()

Text1.Enabled = False

Text2.Enabled = False

Text3.Enabled = False

Text4.Enabled = False

Text5.Enabled = False

Command11.Visible = False

Command12.Visible = False

Command7.Enabled = True

Command8.Enabled = True

Command9.Enabled = True

Command10.Enabled = True

Command3.Enabled = True

Command4.Enabled = True

Command5.Enabled = True

Command6.Enabled = True

End Sub

Private Sub sidatos()

Text1.Enabled = True

Text2.Enabled = True

Text3.Enabled = True

Text4.Enabled = True

Text5.Enabled = True

Command11.Visible = True

Command12.Visible = True

Command7.Enabled = False

Command8.Enabled = False

Command9.Enabled = False

Command10.Enabled = False

Command3.Enabled = False

Command4.Enabled = False

Command5.Enabled = False

Command6.Enabled = False

End Sub