Funciones
A continuación se describen las funciones que gestionarán el manejo de la base de datos y coordinarán la normativa de la empresa. Estas funciones serán accesibles desde cualquier programa cliente que lo precise.
AbrirConexion
Descripción: Abre una conexión con la base de datos con los parámetros establecidos en la propiedad CadenaConexion.
Código:
' ***************************************************
' Abrir una conexión con bases de datos.
' ***************************************************
Public Function AbrirConexion() As Boolean
On Error GoTo ErrorConexion
Set Conexion = New ADODB.Connection
Conexion.CursorLocation = adUseClient
Conexion.Open CadenaConexion
On Error GoTo 0
HayConexionAbierta = True
SalirAbrirConexion:
Exit Function
ErrorConexion:
RaiseEvent MGError(200, "Error al abrir conexión. "
+ vbCrLf + Str$(Err.Number) + " - " + Err.Description)
Resume SalirAbrirConexion
End Function
AbrirSeleccion
Descripción: Abre una selección, (siempre y cuando haya una conexión abierta).
Código:
' ***************************************************
' Abrir tabla o selección de datos.
' ***************************************************
' Parámetros :
' TablaSeleccion : Nombre de la tabla o instrucción SQL
' TipoCursor : Tipo de cursor.
' TipoApertura : Modo de apertura.
' ***************************************************
Public Function AbrirSeleccion(TablaSeleccion As String, TipoCursor As CursorTypeEnum,
TipoApertura As LockTypeEnum) As Long
If HaySeleccionAbierta Then ' Si ya hay una selección abierta. Debe cerrarse antes.
RaiseEvent MGError(120, "Ya hay una selección abierta.")
Else ' Ok. Abrir selección.
If HayConexionAbierta Then ' Hay una conexión abierta.
On Error GoTo ErrorAbrirSeleccion
' Abre el recordset.
Set Datos = New ADODB.Recordset
Datos.Open TablaSeleccion, Conexion, TipoCursor, TipoApertura
AbrirSeleccion = Datos.RecordCount
On Error GoTo 0
HaySeleccionAbierta = True
Else ' No hay una conexión abierta. No se puede abrir la selección.
RaiseEvent MGError(110, "No hay una conexión abierta.")
AbrirSeleccion = -1
HaySeleccionAbierta = False
End If
End If
SalirAbrirSeleccion:
Exit Function
ErrorAbrirSeleccion:
RaiseEvent MGError(205, "Error al abrir la selección." + vbCrLf + Str$(Err.Number)
+ " - " + Err.Description)
HaySeleccionAbierta = False
Resume SalirAbrirSeleccion
End Function
AddCadenaConexión
Descripción: Añade los parametros necesarios para luego abrir una conexión.
Código:
' ***************************************************
' Activa una cadena de conexión.
' ***************************************************
' Parámetros :
' TipoConexion : Establece el tipo de conexión.
' Conexiones disponibles en la
' enumeración MGADBaseConexion
' ***************************************************
Public Sub AddCadenaConexion(ByVal TipoConexion As MGADBaseConexion)
If HayConexionAbierta Then
RaiseEvent MGError(100, "Hay una conexión abierta.
No puede manipular las propiedades de origen de los datos.")
Else
Select Case TipoConexion
Case bcJet ' Cadena de conexión con OLEDB.Jet
If Len(DBNombreDBDSN) = 0 Then ' La ruta completa está en DBDIRMDB
mvarCadenaConexion = "Provider=Microsoft.Jet.OLEDB.4.0;Password="
+ DBPassword + ";User ID=" + DBUser + ";Data Source=" + DBDirMDB
Else ' La ruta de la base de datos está en DBDIRMDB y DBNombreDBDSN
mvarCadenaConexion = "Provider=Microsoft.Jet.OLEDB.4.0;Password="
+ DBPassword + ";User ID=" + DBUser + ";Data Source=" + DBDirMDB
+ "\" + DBNombreDBDSN
End If
Case bcDSN ' Cadena de conexión con DSN.
mvarCadenaConexion = "DSN=" + DBNombreDBDSN + ";UID=" + DBUser
+ ";PWD=" + DBPassword
End Select
End If
End Sub
AddModRegEmpresa
Descripción: Añade o, si el registro existe, modifica un registro de empresa en la base de datos de prueba.
Código:
' ***************************************************
' Añade o modifica un registro de empresa.
' Si el registro existe lo modifica, si no existe lo añade.
' ***************************************************
' Parámetros :
' re : Registro de empresa.
' ***************************************************
Public Function AddModRegEmpresa(re As MGADRegEmpresas) As Boolean
Dim Comando As ADODB.Recordset
If VerificarRegEmpresa(re) Then
AddModRegEmpresa = True
On Error GoTo ErrorAddModRegEmpresa
' Busca si el registro de la empresa ya existe.
Set Comando = New ADODB.Recordset
Comando.Open "SELECT * FROM Empresas WHERE CodEmpresa = " &
re.CodEmpresa, Conexion, adOpenForwardOnly, adLockReadOnly
If Comando.RecordCount > 0 Then ' El registro existe.
' Modificación del registro.
Conexion.Execute "UPDATE Empresas SET CodEmpresa = " & re.CodEmpresa & ",
Nombre = '" + re.Nombre + "', Direccion1 = '" + re.Direccion1 + "',
Direccion2 = '" + re.Direccion2 + "', Direccion3 = '" + re.Direccion3 + "',
ContadorRecibos = " & re.ContadorRecibos & ", RegMercantil = '" +
re.RegMercantil + "' WHERE CodEmpresa = " & re.CodEmpresa
Else ' El registro no existe.
' Add registro.
Conexion.Execute "INSERT INTO Empresas (CodEmpresa, Nombre, Direccion1,
Direccion2, Direccion3, ContadorRecibos, RegMercantil) VALUES
(" & re.CodEmpresa & ", '" + re.Nombre + "', '" + re.Direccion1
+ "', '" + re.Direccion2 + "', '" + re.Direccion3 + "', " & re.ContadorRecibos
& ", '" + re.RegMercantil + "')"
End If
RefrescaSeleccion
On Error GoTo 0
Else ' Alguno de los campos de la empresa no es correcto.
AddModRegEmpresa = False
End If
SalirAddModRegEmpresa:
Set Comando = Nothing
Exit Function
ErrorAddModRegEmpresa:
AddModRegEmpresa = False
RaiseEvent MGError(300, "El registro no ha podido añadirse o modificarse."
+ vbCrLf + Str$(Err.Number) + " - " + Err.Description)
Resume SalirAddModRegEmpresa
End Function
BuscarRegistro
Descripción: Busca un registro por el filtro y en el modo especificados.
Código:
' ***************************************************
' Buscar registro.
' ***************************************************
' Parámetros :
' Condicion : Condición de búsqueda.
' TipoBusqueda : Tipo de busqueda según MGADTiposBusqueda
' ***************************************************
Public Function BuscarRegistro(Condicion As String, TipoBusqueda As MGADTiposBusqueda) As Boolean
Dim tb As SearchDirectionEnum ' Tipo de búsqueda.
BuscarRegistro = True
If HaySeleccionAbierta Then
On Error GoTo ErrorBuscar
' ¿Buscar desde el inicio?
Select Case TipoBusqueda
Case tbInicio ' Buscar desde el inicio.
On Error Resume Next
Datos.MoveFirst
On Error GoTo 0
tb = adSearchForward
Case tbSiguiente ' Buscar siguiente.
tb = adSearchForward
Case tbAnterior ' Buscar anterior.
tb = adSearchBackward
End Select
' Búsqueda.
Datos.Find Condicion, , tb
If Datos.EOF Then ' Si llega al final de la selección es que
no ha hallado el registro buscado.
RaiseEvent MGError(160, "El registro no ha sido hallado.")
BuscarRegistro = False
End If
On Error GoTo 0
Else ' No hay una selección abierta. No puede buscar.
RaiseEvent MGError(120, "No hay una selección abierta.")
End If
SalirBuscar:
Exit Function
ErrorBuscar:
BuscarRegistro = False
RaiseEvent MGError(150, "Error al buscar en la selección." + vbCrLf + Str$(Err.Number)
+ " - " + Err.Description)
Resume SalirBuscar
End Function
CerrarConexion
Descripción: Cierra la selección y la conexión abiertas.
Previo al cierre de la clase en el cliente.
Código:
' ***************************************************
' Cerrar la conexión con bases de datos.
' ***************************************************
Public Function CerrarConexion() As Boolean
On Error Resume Next
Datos.Close
Set Datos = Nothing
On Error GoTo ErrorCerrarConexion
Conexion.Close
Set Conexion = Nothing
On Error GoTo 0
HaySeleccionAbierta = False
HayConexionAbierta = False
SalirCerrarConexion:
Exit Function
ErrorCerrarConexion:
RaiseEvent MGError(210, "Error al cerrar conexión. " + vbCrLf + Str$(Err.Number)
+ " - " + Err.Description)
Resume SalirCerrarConexion
End Function
DatoCampo
Descripción: Devuelve el dato del campo especificado.
Código:
' ***************************************************
' Devuelve el dato al que apunta el cursor del campo
' solicitado.
' ***************************************************
' Parámetros :
' Campo : Indice o literal del campo a recuperar.
' ***************************************************
Public Function DatoCampo(Campo) As Variant
If HaySeleccionAbierta Then
On Error GoTo ErrorDatoCampo
If Not IsNull(Datos.Fields(Campo).Value) Then
' Si el campo no es nulo devuelve su contenido.
DatoCampo = Datos.Fields(Campo).Value
Else ' El campo es nulo. Devuelve una cadena vacia.
DatoCampo = ""
End If
On Error GoTo 0
Else ' No hay una selección abierta.
RaiseEvent MGError(120, "No hay una selección abierta.")
End If
SalirDatoCampo:
Exit Function
ErrorDatoCampo:
DatoCampo = ""
RaiseEvent MGError(170, "Error al obtener el dato de un campo del registro actual."
+ vbCrLf + Str$(Err.Number) + " - " + Err.Description)
Resume SalirDatoCampo
End Function
EliminarRegistro
Descripción: Elimina el registro al que apunta el cursor de la selección o por sentencia SQL.
Código:
' ***************************************************
' Eliminar registro.
' Si Condicion = "" borra el registro actual.
' ***************************************************
' Parámetros :
' SQLCondicion : OPCIONAL. Eliminar por SQL.
' ***************************************************
Public Function EliminarRegistro(Optional SQLCondicion As String) As Boolean
EliminarRegistro = True
On Error GoTo ErrorEliminarRegistro
If Len(SQLCondicion) = 0 Then ' Borrar registro actual.
Datos.Delete adAffectCurrent
Else ' Borrar por la condicion.
Conexion.Execute SQLCondicion
End If
RefrescaSeleccion
On Error GoTo 0
SalirEliminarRegistro:
Exit Function
ErrorEliminarRegistro:
EliminarRegistro = False
RaiseEvent MGError(310, "No puede eliminarse el/los registro(s)."
+ vbCrLf + Str$(Err.Number) + " - " + Err.Description)
Resume SalirEliminarRegistro
End Function
MoverAnterior, MoverFinal, MoverInicio y MoverSiguiente
Descripción: Mueve el cursor de la selección.
Código:
Sólo MoverInicio.
' ***************************************************
' Mover al primer registro.
' ***************************************************
Public Sub MoverInicio()
If HaySeleccionAbierta Then
On Error GoTo ErrorMover
Datos.MoveFirst
On Error GoTo 0
Else
RaiseEvent MGError(120, "No hay una selección abierta.")
End If
SalirMover:
Exit Sub
ErrorMover:
RaiseEvent MGError(140, "Error al mover en la selección." + vbCrLf
+ Str$(Err.Number) + " - " + Err.Description)
Resume SalirMover
End Sub
RefrescaSeleccion
Descripción: Refresca la selección actual, (Requery).
Código:
' ***************************************************
' Refresca la selección actual.
' ***************************************************
Public Function RefrescaSeleccion() As Boolean
If HaySeleccionAbierta Then
On Error GoTo ErrorRefrescar
Datos.Requery
On Error GoTo 0
Else
RaiseEvent MGError(120, "No hay una selección abierta.")
End If
SalirRefrescar:
Exit Function
ErrorRefrescar:
RaiseEvent MGError(130, "Error al refrescar la selección." + vbCrLf
+ Str$(Err.Number) + " - " + Err.Description)
Resume SalirRefrescar
End Function
VerificarRegEmpresa
Descripción: Verifica la integridad y validez de los datos de una empresa. Esta función se ejecuta automáticamente antes del alta o modificar la empresa. Ejemplo de normativa de la empresa.
Código:
' ***************************************************
' Verificar validez de los campos de Empresa.
' ***************************************************
' Parámetros :
' re : Registro de empresa.
' ***************************************************
Public Function VerificarRegEmpresa(re As MGADRegEmpresas) As Boolean
VerificarRegEmpresa = True
With re
If .CodEmpresa <= 0 Or .ContadorRecibos < 0 Or .Direccion1 = "" Or
.Direccion2 = "" Or .Direccion3 = "" Or .Nombre = "" Then
' Hubo un error en la cumplimentación de la ficha de empresa.
VerificarRegEmpresa = False
RaiseEvent MGError(1000, "Alguno de los campos de la empresa no es correcto.")
End If
End With
End Function
Tutoriales
