Contraseña para entrar en una base de datos

 volver al índex

Introducir un código de acceso en un campo de texto y permitir o impedir el acceso a la base de datos

Primero, hay que crear una función pública que recoja, en una variable, la clave introducida.
Esta clave será visible y se podrá utilizar en todo el proyecto.
La función, la pondremos en un módulo nuevo:

Option Compare Database
Public entrarclave As String

Public Function Damevalor() As Integer
Damevalor = entrarclave
End Function

Segundo, generamos el siguiente procedimiento de evento en el apartado "Despues de actualizar" dentro de las propiedades del campo de texto:

Private Sub nombredelTextbox_AfterUpdate()
'recojemos la clave introducida
entrarclave = nombredelTextbox.Value
'Si la clave introducida corresponde al acceso a la base de datos, damos paso y abrimos un formulario
menú y cerramos el formulario de acceso. Si la clave no es correcta, mostramos mensaje y salimos
If entrarclave = "clave_acceso_bd_original" Then
DoCmd.OpenForm "Formulario_menu"
DoCmd.Close acForm, "Formulario_password"
Else
MsgBox ("no tienes acceso")
DoCmd.Close acForm, "Formulario_password"
DoCmd.Quit
End If
End Sub

Generar valor único al dar de alta un registro

 volver al índex

En un formulario queremos dar de alta registros con un código de identificación único que tenga el fórmato XXAÑO/00000. Generamos el siguiente procedimiento de evento en el apartado "al hacer click" de las propiedades de un botón:

Private Sub altaregistro_Click()
Dim abrirtabla As DAO.Recordset
Dim num, incremento As Long
Dim digitos, cadena, letras, numentexto As String
Dim valormaximo, partfinal, convertirtexto, partemedioyfinal, valorfinal As String

'abrimos registro nuevo
DoCmd.GoToRecord , , acNewRec
'Guardamos en la variable cadena el número d'expediente 1 por si fuera el primer registro
que damos de alta. Al ser el campo número_expediente de tipo texto, hay que convertir todas las partes
que conforman el valor de cadena a texto.
digitos = "/0000"
letras= "XX"
an = Year(Date)
num = 1
numentexto = CStr(num)
añoentexto = CStr(an)
cadena = letras + añoentexto + digitos+ numentexto
'abrimos la tabla que contiene el campo número_expediente, comprobamos si está vacio o no.
Si está vacio, pasamos el valor de la variable cadena al textbox del formulario. Si la tabla no está vacia,
buscamos el número_expediente más alto y lo incrementamos en uno y lo pasamos a la variable convertirtexto
Set abrirtabla = CurrentDb().OpenRecordset("tabla")
If abrirtabla.EOF = True And abrirtabla.BOF = True Then
abrirtabla.Close
número_expediente.Text = cadena
Else
abrirtabla.Close
númeromásalto = DMax("[número_expediente]", "tabla")
partefinal = Mid(númeromásalto, 8, 5)
incremento = CLng(partefinal) + 1
convertirtexto = CStr(incremento)
'en función del número de dígitos detectados en la variable convertirtexto mediante
la función Len(), pasaremos la variable valorfinal al textbox del formulario
Select Case Len(convertirtexto)
Case 1
partemedioyfinal = "/0000" + convertirtexto
valorfinal = letras + añoentexto + partemedioyfinal
número_expediente.Setfocus
número_expediente.Text = valorfinal
Case 2
partemedioyfinal = "/000" + convertirtexto
valorfinal = letras+ añoentexto + partemedioyfinal
número_expediente.Setfocus
número_expediente.Text = valorfinal
Case 3
partemedioyfinal = "/00" + convertirtexto
valorfinal = letras + añoentexto + partemedioyfinal
número_expediente.Setfocus
número_expediente.Text = valorfinal
Case 4
partemedioyfinal = "/0" + convertirtexto
valorfinal = letras + añoentexto + partemedioyfinal
número_expediente.Setfocus
número_expediente.Text = valorfinal
Case 5
partemedioyfinal = "/" + convertirtexto
valorfinal = letras + añoentexto + partemedioyfinal
número_expediente.Setfocus
número_expediente.Text = valorfinal
End Select
End If

Comprobar si existe un registro cuando se da de alta

 volver al índex

Por ejemplo, antes de dar de alta un registro, comprobaremos que no exista en la tabla correspondiente. En caso que sí exista, mostraremos un msgbox para decirlo y saldremos del procedimiento.
Generamos el siguiente procedimiento de evento en la propiedad "al hacer clic" de un botón:

Private Sub altanifreal_Click()
'declaramos variables
Dim consultatabla As DAO.Recordset
Dim valor, valornif As String
Dim pos As Long
Dim caracters As String
Dim conmutador

caracters = "-/: "
conmutador = False

'mostramos por pantalla un cuadro para poner el valor que queremos comprobar
para eso utilizamos la función InputBox()
valor = InputBox("Pon el DNI: ")

'ahora, con una estructura condicional, comprobaremos que este valor tiene
9 caracteres y ninguno de ellos está en la variable caracters
If valor = "" Then
Exit Sub
Else
  If Len(valor) < 9 Or Len(valor) > 9 Then
  MsgBox ("el valor debe tener 9 caracteres, por favor, vuelve a ponerlo")
  Exit Sub
  Else
  For i = 1 To 4
  pos = InStr(1, valor, Mid(caracters, i, 1))
   If pos > 0 Then
   Exit For
   End If
  Next i

  If pos > 0 Then
  MsgBox ("El valor no puede tener ningún carácter extraño ni espacios en blanco")
  Exit Sub
  Else
  End If
  End If
End If

'Si el valor introducido es correcto, abrimos un recordset con los registros
de la tabla para comprobar si el valor existe. En caso que sí, mensaje y salimos del procedimiento.
En caso que no, damos de alta un registro nuevo
Set consultatabla = CurrentDb().OpenRecordset("SELECT tabla.camp1 FROM tabla;")
If consultatabla.EOF And consultatabla.BOF = True Then
Else
consultatabla.Edit
consultatabla.MoveFirst
  Do
  valornif = consultatabla!camp1
  If valornif = valor Then
  MsgBox ("el valor ya existe")
  conmutador = True
  Exit Do
  End If
  consultatabla.MoveNext
  Loop Until consultatabla.EOF
End If
consultatabla.Close

If conmutador = False Then
DoCmd.GoToRecord , , acNewRec
'cargamos el valor introducido en un campo de texto del formulario
Me.textbox.Text.Setfocus
Me.textbox.Text = valor
Else
End If
End Sub

Enviar un archivo por correo electrónico mediante Outlook

 volver al índex

Procedimiento para enviar cualquier archivo que tengamos en local o en red mediante la aplicación Outlook. En un botón que tengamos en un formulario, generamos el siguiente código al hacer clic:

Private Sub correo_Click()
'Definimos una rutina de intercepción de errores
On Error GoTo control
'Declaramos las variables para poder abrir Outlook y sus propiedades
Dim outApp As Outlook.Application
Dim outNsp As Outlook.NameSpace
Dim olMail As Outlook.MailItem

If MsgBox("quieres iniciar el proceso de comunicación?", vbYesNo + vbExclamation, "ATENCIÓN") = vbYes Then
Set outApp = CreateObject("Outlook.Application")
Set outNsp = outApp.GetNamespace("MAPI")
outNsp.Logon
Set olMail = outApp.CreateItem(olMailItem)
olMail.To = "aqui va la dirección de correo electrónico"
olMail.Subject = "aqui va el asunto del mensaje"
olMail.Attachments.add "C:\\aqui va toda la ruta del documento o fichero que queremos adjuntar al correo"
olMail.Body = "Aquí va el texto para poner en el cuerpo del correo"
olMail.Send
outNsp.Logoff
Set outNsp = Nothing
Set olMail = Nothing
Set outApp = Nothing
Else
End If
'En caso de detectarse algún error de Outlook, per cuestiones de seguridad o cualquier otra
se activa esta rutina de errores que permite salir del procedimiento Exit_salida:
Exit Sub
control:
If Err.Number = 287 Then
MsgBox ("se ha producido algún error, contactad con el administrador")
End If
Resume Exit_salida
End Sub

Conexión a una base de datos externa de access

 volver al índex

Si nos interesa desde nuestra propia base de datos hacer una conexión a una base de datos externa, podemos generar el siguiente procedimiento cuando hacemos clic en un botón de un formulario:

Private Sub botón_Click()
'definimos las variables de conexión y de acceso a un grupo de registros
Dim conexion As New ADODB.Connection
Dim consultaregistros As New ADODB.Recordset
'establecemos la conexión a la base de datos externa, especificando toda la ruta
conexion.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=\\ruta\bd.mdb" conexion.Open
'ahora ya podemos manipular la BD externa. Por ejemplo, podemos abrir la consulta,
calcular el núm. de registros que tiene una tabla y mostrar el resultado en un msgbox
consultaregistros.Open "SELECT tabla.camp1 FROM tabla", conexion, adOpenStatic, adLockPessimistic
registros_tabla_externa = consultaregistros.RecordCount
MsgBox ("núm, de registros:" & registros_tabla_externa)
consultaregistros.Close
Set consultaregistros = Nothing