Validare adresa email

Ce este nou in Microsoft Excel 2016?
Informatii despre cum se utilizeaza Microsoft Excel 2016
Calcule, Formule, Functii, Tabele pivot, Analiza datelor, etc
vionescu71
Mesaje: 1
Membru din: Vin Aug 07, 2020 2:31 pm

Validare adresa email

Mesaj de vionescu71 » Mie Aug 12, 2020 8:42 pm

Salut,

S-a mai discutat despre acest subiect si sunt diverse variante care folosesc "Regular Expression".

Dar se pare ca nu functioneaza pentru adresele de tipul "ionut..popescu@office" - adica vorbim de 2 puncte consecutive.

O solutie clasica ar fi:

Function IsValidEmail(sEmail As String) As Boolean
Dim sInvalidChars As String
Dim bTemp As Boolean
Dim i As Integer
Dim stemp As String

' Lista caractere nepermise
sInvalidChars = "!#$%^&*()=+{}[]|\;:'/?>,< "

' Verifica daca exista caracterul @
bTemp = InStr(sEmail, "@") <= 0
If bTemp Then GoTo exit_function

' Verifica daca exista cel putin un caracter .
bTemp = InStr(sEmail, ".") <= 0
If bTemp Then GoTo exit_function

' Verifica daca lungimea adresei este cel putin 6 (a@a.a nu este bine)
bTemp = Len(sEmail) < 6
If bTemp Then GoTo exit_function

' Verifica daca exista doar un caracter @
i = InStr(sEmail, "@")
stemp = Mid(sEmail, i + 1)
bTemp = InStr(stemp, "@") > 0
If bTemp Then GoTo exit_function

' Verificare suplimentara
' Dupa caracterul @ nu este permis spatiu
bTemp = InStr(stemp, " ") > 0
If bTemp Then GoTo exit_function

' Verificare suplimentara
' Dupa caracterul @ nu este permis punct
bTemp = Left(stemp, 1) = "."
If bTemp Then GoTo exit_function

' Verifica daca exista cel putin un . dupa caracterul @
bTemp = InStr(stemp, ".") = 0
If bTemp Then GoTo exit_function

' Verifica daca exista caracterul "
bTemp = InStr(sEmail, Chr(34)) > 0
If bTemp Then GoTo exit_function

' Verifica existenta caracterelor nepermise
If Len(sEmail) > Len(sInvalidChars) Then
For i = 1 To Len(sInvalidChars)
If InStr(sEmail, Mid(sInvalidChars, i, 1)) > 0 _
Then bTemp = True
If bTemp Then Exit For
Next
Else
For i = 1 To Len(sEmail)
If InStr(sInvalidChars, Mid(sEmail, i, 1)) > 0 _
Then bTemp = True
If bTemp Then Exit For
Next
End If
If bTemp Then GoTo exit_function

' Verificare suplimentara
' Nu sunt permise doua caractere . (punct) consecutive
bTemp = InStr(sEmail, "..") > 0
If bTemp Then GoTo exit_function

' Verificare suplimentara
' La domeniu trebuiesc minim 2 caractere
bTemp = ((Len(sEmail)) < (InStr(sEmail, ".") + 2))
If bTemp Then GoTo exit_function

exit_function:
' Daca cel putin o conditie din cele de mai sus este TRUE
' atunci adresa de email este invalida
IsValidEmail = Not bTemp

End Function
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Scrie răspuns

Înapoi la “Intrebari despre Excel 2016”