Hola gente os dejo un MODULO BAS para principiantes y que quieran conectar con bases de datos ACCESS.
Tiene lo basico:
CONEXION
AGREGAR REGISTROS
ELIMINAR REGISTROS
ACTUALIZAR REGISTROS
DESCONECTAR
Un saludito a todos
Os dejo el codigo :
Option Explicit
Public Conexion As ADODB.Connection
Public rst As ADODB.Recordset
Public sql As String
'*********************************************************
'* MODULO DE CONEXION PARA BASE DATOS
'*
'* MICROSOFT ACCESS
'*
'*
'* POR: Julio Danvila
'*
'* EMAIL: jdcssm@ono.com
'*
'*********************************************************
Public Function conectar(fr As Form)
Dim rutaBase As String
Dim baseDatos As String
'Obtenemos la ruta y nombre de la base de datos
baseDatos = "\TuBaseDeDatos.mdb"
rutaBase = App.Path & baseDatos
'Creamos el objeto para realizar la conexion
Set Conexion = New ADODB.Connection
'Creamos el objeto que almacenara los registros de nuestras Consultas
Set rst = New ADODB.Recordset
'Creamos el STRING de Conexion a la Base de Datos y la abrimos
Conexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & rutaBase & "'"
'Indicamos como queremos que abra la base de datos de lado del cliente
Conexion.CursorLocation = adUseClient
If Conexion.State = adStateOpen Then
'barra de estado para indicarnos que la base de datos se ha abierto correctamente
fr.stbar.Panels(1).Text = " Conectado a la base de datos ......"
fr.stbar.Panels(2).Text = Format(Date, "dd/mm/yyyy")
Else
'barra de estado para indicarnos que la base de datos NO se ha abierto correctamente
fr.stbar.Panels(1).Text = " NO Conectado a la base de datos ......"
fr.stbar.Panels(2).Text = Format(Date, "dd/mm/yyyy")
End If
End Function
Public Function desconectar(fr As Form)
'Si la Conexion esta en estado distinto de cerrada entonces la CERRAMOS.
If Conexion.State <> adStateClosed Then
Conexion.Close
End If
'Si el RECORDSET esta en estado distinto de cerrado entonces lo CERRAMOS.
If rst.State <> adStateClosed Then
rst.Close
End If
'Indicamos el estado de la conexion a la base de datos
fr.stbar.Panels(1).Text = " NO Conectado a la base de datos ......"
fr.stbar.Panels(2).Text = Format(Date, "dd/mm/yyyy")
End Function
Public Function Borrar_Datos(dato As String, criterio As String, tabla As String)
'Creamos la Sentencia SQL para borrar los datos. Borra de la tabla "TABLA" todos los registros
'que coincidan con el "CRITERIO" = AQUI NOS FALTA EL DATO A BUSCAR lo pondremos mas abajo0
sql = "DELETE FROM '" & tabla & "' WHERE '" & criterio & "' ="
'Para que la sentencia funcione correctamente eliminamos los simbolos "'" de la Instruccion SQL
sql = Replace(sql, "'", " ")
'Una vez eliminados los "'" reconstruimos la sentencia SQL y Añadimos el DATO a buscar
sql = sql & " '" & dato & "' "
'Preguntamos por el estado del Recodset y si esta Cerrado lo abrimos
'Si esta abierto, lo cerramos y lo abrimos con las caracteristicas que indicamos.
If rst.State = adStateClosed Then
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
rst.Open tabla, Conexion
Else
rst.Close
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
rst.Open tabla, Conexion
End If
'Ejecutamos la sentencia SQL que borrara los datos de la tabla.
Set rst = Conexion.Execute(sql)
End Function
Public Function Buscar(dato As String, criterio As String, tabla As String, fr As Form, dg As dataGrid)
'Creamos la Sentencia SQL para buscar todos los Registros que coincidan con el DATO.
'Pueden ser clientes o cualquier campo de la tabla que elijas
sql = "SELECT * FROM '" & tabla & "' WHERE '" & criterio & "' ="
'Para que la sentencia funcione correctamente eliminamos los simbolos "'" de la Instruccion SQL
sql = Replace(sql, "'", " ")
'Una vez eliminados los "'" reconstruimos la sentencia SQL y Añadimos el DATO a buscar
sql = sql & " '" & dato & "' "
'ejecutamos la Busqueda
Set rst = Conexion.Execute(sql)
If rst.EOF = True Then
'El registro NO Existe
'No se han Encontrado Registros
Else
'El registro SI existe
'Si se han encontrado Registros
'Los mostramos en el Datagrid del formulario que hayamos pasado a la funcion
Set fr.dg.DataSource = rst
'Ponemos en Negrita los encabezados de las columnas
fr.dg.HeadFont.Bold = True
'Ponemos medida de ancho a la columna "0" esto es la Primera columna que aparecera
fr.dg.Columns.Item(0).Width = 700
'Colocamos los datos de la columna en la parte derecha
fr.dg.Columns.Item(0).Alignment = dbgRight
End If
End Function
Public Function actualizar_registros(datoBuscar As String, datoActualizar As String, criterio As String, tabla As String, fr As Form)
Dim sql1 As String
Dim sql2 As String
'Creamos la Sentencia SQL para buscar el CRITERIO que coincida con el Dato a Buscar y asi lo ACTUALIZAREMOS
'Por el DATO a ACTUALIZAR
sql1 = "UPDATE '" & tabla & "' SET '" & criterio & "' = "
'Para que la sentencia funcione correctamente eliminamos los simbolos "'" de la Instruccion SQL
sql1 = Replace(sql1, "'", " ")
sql2 = " WHERE '" & criterio & "' ="
'Para que la sentencia funcione correctamente eliminamos los simbolos "'" de la Instruccion SQL
sql2 = Replace(sql2, "'", " ")
sql = sql1 & " '" & datoActualizar & "' " & sql2 & " '" & datoBuscar & "' "
'Una vez eliminados los "'" reconstruimos la sentencia SQL y Añadimos el DATO a buscar
'Ejecutamos la Actualizacion
Set rst = Conexion.Execute(sql)
'Indicamos que se ha actualizado correctamente
fr.stbar.Panels(1).Text = " Datos Actualizados ......"
fr.stbar.Panels(2).Text = Format(Date, "dd/mm/yyyy")
End Function
Public Function crear_registros(tabla As String, ValorFicha As String, ValorArticulo As String, ValorTalla As String, fr As Form)
'Preguntamos por el estado del Recodset y si esta Cerrado lo abrimos
'Si esta abierto, lo cerramos y lo abrimos con las caracteristicas que indicamos.
If rst.State = adStateClosed Then
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
rst.Open tabla, Conexion
Else
rst.Close
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
rst.CursorLocation = adUseClient
rst.Open tabla, Conexion
End If
'Indicamos que vamos a añadir un Nuevo Registro a la Tabla
rst.AddNew
'indicamos los campos creados en la tabla y le asignamos con el simbolo = el Valor que deseamos.
'UCASE es para guardar los registros en Mayusculas
rst!ficha = UCase(ValorFicha)
rst!articulo = UCase(ValorArticulo)
rst!talla = UCase(ValorTalla)
'Actualizamos los datos en la Tabla para poder usarlos de inmediato
rst.Update
'Indicamos que se ha ingresado los datos en la tabla.
fr.stbar.Panels(1).Text = " Registro Realizado con Exito....."
fr.stbar.Panels(2).Text = Format(Date, "dd/mm/yyyy")
End Function
