Clicar un codi d'accés en un camp de text i permetre o impedir l'accés a la base de dades
Primer, cal crear un funció pública que reculli, en una variable, la clau introduida.
Aquesta clau será visible y es podrà utilitzar en tot el projecte.
La funció, la posarem en un nou mòdul:
Option Compare Database
Public entrarclau As String
Public Function Donamvalor() As Integer
Donamvalor = entrarclau
End Function
Segon, generem el següent procediment d'event a l'apartat "Després d'actualitzar" dins les propietats del camp de text:
Private Sub nomdelTextbox_AfterUpdate()
'recollim la clau introduida
entrarclau = nomdelTextbox.Value
'Si la clau introduida correspon a l'accés a la base de dades donem pas i obrim un formulari
menú i tanquem el formulari d'accés. Si la clau no és correcta, mostrem missatge i sortim
If entrarclau = "clau_acces_bd_original" Then
DoCmd.OpenForm "Formulari_menu"
DoCmd.Close acForm, "Formulari_password"
Else
MsgBox ("no tens accés")
DoCmd.Close acForm, "Formulari_password"
DoCmd.Quit
End If
End Sub
En un formulari volem donar d'alta registres amb un codi d'identificació únic que tingui el format XXANY/00000. Generem el següent procediment d'event a l'apartat "en fer click" de les propietats d'un botó:
Private Sub altaregistre_Click()
Dim obrirtaula As DAO.Recordset
Dim num, increment As Long
Dim digits, cadena, lletres, numentexte As String
Dim valormàxim, partfinal, convertirtexte, partmigifinal, valorfinal As String
'obrim registre nou
DoCmd.GoToRecord , , acNewRec
'Guardarem en la variable cadena el número d'expedient 1 per si fos el primer registre
que volem donar d'alta. Com que el camp número_expedient és de tipus texte, cal convertir totes les parts
que conformen el valor de cadena a texte.
digits = "/0000"
lletres= "XX"
an = Year(Date)
num = 1
numentexte = CStr(num)
anyentexte = CStr(an)
cadena = lletres + anyentexte + digits+ numentexte
'obrim la taula que conté el camp número_expedient, comprovem si està buida o no.
Si està buida, passem el valor de la variable cadena al textbox del formulari. Si la taula no està buida,
cerquem el número_expedient més alt i l'incrementem en un i el passem a la variable convertirtexte
Set obrirtaula = CurrentDb().OpenRecordset("taula")
If obrirtaula.EOF = True And obrirtaula.BOF = True Then
obrirtaula.Close
número_expedient.Text = cadena
Else
obrirtaula.Close
númeromésalt = DMax("[número_expedient]", "taula")
partfinal = Mid(númeromésalt, 8, 5)
increment = CLng(partfinal) + 1
convertirtexte = CStr(increment)
'en funció del número de dígits detectats a la variable convertirtexte mitjançant
la funció Len(), passarem la variable valorfinal al textbox del formulari
Select Case Len(convertirtexte)
Case 1
partmigifinal = "/0000" + convertirtexte
valorfinal = lletres + anyentexte + partmigifinal
número_expedient.Setfocus
número_expedient.Text = valorfinal
Case 2
partmigifinal = "/000" + convertirtexte
valorfinal = lletres+ anyentexte + partmigifinal
número_expedient.Setfocus
número_expedient.Text = valorfinal
Case 3
partmigifinal = "/00" + convertirtexte
valorfinal = lletres+ anyentexte + partmigifinal
número_expedient.Setfocus
número_expedient.Text = valorfinal
Case 4
partmigifinal = "/0" + convertirtexte
valorfinal = lletres+ anyentexte + partmigifinal
número_expedient.Setfocus
número_expedient.Text = valorfinal
Case 5
partmigifinal = "/" + convertirtexte
valorfinal = lletrest + anyentexte + partmigifinal
número_expedient.Setfocus
número_expedient.Text = valorfinal
End Select
End If
Per exemple, abans de donar d'alta un registre, comprovarem que no existeixi a la taula corresponent.
En cas que sí existeixi, mostrarem un msgbox per dir-ho i sortirem del procediment.
Generem el següent procediment d'event a la propietat "en fer clic" d'un botó:
Private Sub altanifreal_Click()
'declarem les variables
Dim consultataula As DAO.Recordset
Dim valor, valornif As String
Dim pos As Long
Dim caracters As String
Dim conmutador
caracters = "-/: "
conmutador = False
'mostrem per pantalla un quadre per posar el valor que volem comprovar
per això utilitzem la funció InputBox()
valor = InputBox("Posa el DNI: ")
'ara, amb una estructura condicional, comprovarem que aquest valor té
9 caràcters i cap d'ells està recollit a la variable caràcters
If valor = "" Then
Exit Sub
Else
If Len(valor) < 9 Or Len(valor) > 9 Then
MsgBox ("el valor ha de tenir 9 caràcters, si us plau, tornar a posar-lo")
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 pot tenir cap carácter estrany ni espais en blanc")
Exit Sub
Else
End If
End If
End If
'Si el valor introduit és correcte, obrim un recordset amb els registres
de la taula per comprovar si el valor existeixi. En cas que si, missatge i sortim del procediment.
En cas que no, donem d'alta un registre nou
Set consultataula = CurrentDb().OpenRecordset("SELECT taula.camp1 FROM taula;")
If consultataula.EOF And consultataula.BOF = True Then
Else
consultataula.Edit
consultataula.MoveFirst
Do
valornif = consultataula!camp1
If valornif = valor Then
MsgBox ("el valor ja existeix")
conmutador = True
Exit Do
End If
consultataula.MoveNext
Loop Until consultataula.EOF
End If
consultataula.Close
If conmutador = False Then
DoCmd.GoToRecord , , acNewRec
'carreguem el valor introduit en un camp de text del formulari
Me.textbox.Text.Setfocus
Me.textbox.Text = valor
Else
End If
End Sub
Procediment per lliurar qualsevol arxiu que tinguem en local o en xarxa mitjançant l'aplicació Outlook. En un botó que tinguem en un formulari, generem el següent codi en fer clic:
Private Sub correu_Click()
'Definim una rutina d'intercepció d'errors
On Error GoTo control
'Declarem les variables per poder obrir Outlook i les seves propietats
Dim outApp As Outlook.Application
Dim outNsp As Outlook.NameSpace
Dim olMail As Outlook.MailItem
If MsgBox("vols iniciar el procés de comunicació?", vbYesNo + vbExclamation, "ATENCIÓ") = vbYes Then
Set outApp = CreateObject("Outlook.Application")
Set outNsp = outApp.GetNamespace("MAPI")
outNsp.Logon
Set olMail = outApp.CreateItem(olMailItem)
olMail.To = "aqui va l'adreça de correu electrònic"
olMail.Subject = "aqui va l'assumpte del missatge"
olMail.Attachments.add "C:\\aqui va tota la ruta del document o fitxer que volem adjuntar al correu"
olMail.Body = "Aquí va el texte per posar al cos del correu"
olMail.Send
outNsp.Logoff
Set outNsp = Nothing
Set olMail = Nothing
Set outApp = Nothing
Else
End If
'En cas de detectar-se algun error d'Outlook, per questions de seguretat o d'altres
s'activa aquesta rutina d'errors que permet sortir del procediment
Exit_sortida:
Exit Sub
control:
If Err.Number = 287 Then
MsgBox ("s'ha produit algun error, parleu amb l'administrador")
End If
Resume Exit_sortida
End Sub
Si ens interessa des de la nostra pròpia base de dades fer una connexió a una base de dades externa, podem generar el següent procediment quan fem clic en un botó d'un formulari:
Private Sub botó_Click()
'definim les variables de connexió i d'accés a un grup de registres
Dim connexio As New ADODB.Connection
Dim consultaregistres As New ADODB.Recordset
'establim la connexió a la base de dades externa, especificant tota la ruta
connexio.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=\\ruta\bd.mdb"
connexio.Open
'ara ja podem manipular la BD externa. Per exemple, podem obrim la consulta,
cercar el núm. de registres que té una taula i el mostrem en un msgbox
consultaregistres.Open "SELECT taula.camp1 FROM taula", connexio, adOpenStatic, adLockPessimistic
registres_taula_externa = consultaregistres.RecordCount
MsgBox ("núm, de registres:" & registres_taula_externa)
consultaregistres.Close
Set consultaregistres = Nothing