Loading
facebook feed
castellano

Paraula de pas per entrar a una base de dades

 tornar a l'índex

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

Generar valor únic en donar d'alta un registre

 tornar a l'índex

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

Comprovar si existeix un registre quan es dona d'alta

 tornar a l'índex

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

Enviar un arxiu per correu electrònic mitjançant Outlook

 tornar a l'índex

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

Connexió a una base de dades externa d'access

 tornar a l'índex

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

okemos brewing company
quality rock from Okemos, Michigan, USA

windows media player

sobre
Catalunya

catalunya

sobre
Barcelona

barcelona

Valid XHTML 1.0 Transitional

Pere Garcia Guinot   -  

logo personal