[Resolvido] Validação de email

[xanburzum 169]

Validação de email

 

Function ValidaEmail(emailAddress)
'Declara as variaveis 

Dim ValidEmail, emailParts, iLoopCounter, emailChar, acceptableChars
	 ValidEmail = True 'set the default result to True

	  acceptableChars="abcdefghijklmnopqrstuvwxyz.-_@"
	 'usar a função Split para criar um array com o @ como separador

	 'portanto, se seu e-mail foi test@tester.com o e-mail seria dividido em um array

	'com o primeiro o elemento matriz exploração "teste" e o segundo "tester.com"

	 emailParts = Split(emailAddress, "@")
	 'certifique-se que existe apenas 1 @ e que há 2 partes

	 'lembre-se arrays são baseados zero

'Utilizando a função UBound retornará o maior elemento da matriz 

	  'Então, se é um email válido UBound a função retornará 1, ou seja, iniciar 0

	 if UBound(emailParts) <> 1 Then
		  ValidEmail = false
	 Else 
		  'Verificar a duração de cada parte do endereço de e-mail 

		   'primeira parte pode ser apenas um caracter, 2 a parte deve ser pelo menos 4

		  if Len(emailParts(0))<1 OR Len(emailParts(1))<4 Then
			   ValidEmail = false
		  End If
		  'verificar primeiro caracter à esquerda não é uma parte "." Esquerda usando função

		  if Left(emailParts(0), 1)="." Then
			   ValidEmail = false
		  End If

		  if Right(emailParts(1), 1) = "." OR Right(emailParts(1), 2) = "." Then
			   ValidEmail = false
		  End If
'verificar se existe um . na segunda parte do endereço de e-mail -. com

		  if InStr(emailParts(1), ".") <= 0 Then
			   ValidEmail = false 
		  End if 
		'verificar que não deve haver um _ na segunda parte do endereço de email

		  if InStr(emailParts(1), "_") >0 Then
			   ValidEmail = false 
		  End if 
	 End If
		  'loop para cada caracter do email

	 For iLoopCounter = 1 to Len(emailAddress)
	'Usar funções Lcase & Mid , Mid função usada para retornar cada caracter 

	'no e-mail e, em seguida, Lcase converte em minúsculas

	 emailChar = Lcase(Mid(emailAddress, iLoopCounter, 1)) 
  'Verificar se os caracteres de EMAILADDRESS são aceitáveis

		  if InStr(acceptableChars, emailChar) = 0 and Not IsNumeric(emailChar) Then
			   ValidEmail = false
		  End if
	 Next
	 'verificar se há 2. em uma na row

	 if InStr(emailAddress, "..") > 0 Then
		  ValidEmail=false
	 End If
	 'verificar se existe @.

	 if InStr(emailAddress, "@.") > 0 Then
		  ValidEmail=false
	 End if 
	 ValidaEmail=ValidEmail
End function