' FUNCION DE VALIDACIÓN DE EMAIL
Function ValidarEMAIL(EMAIL)
	' EMailOK.inc 
	' Ignacio Reverte - irevertem@hotmail.com - 2002 
	' Mejoras: Ricardo Arce - jorik@costarricense.cr - 2003 
	' V 2.0 - Gracias a vuestras colaboraciones
	' --------- Funcion que comprueba si un e-mail es valido. Autómata finito de 8 estados (inic:0 - finales: 6, 7 y 8) 
	' La función devolverá: 
	' vbEMailNulo = 0 - si es nulo o esta vacio 
	' vbEMailNoOK = 1 - Si el e-mail es incorrecto 
	' vbEMailOK = 2 - Si el e-mail es valido 
	Const vbEMailNulo = 0
	Const vbEMailNoOK = 1
	Const vbEMailOK = 2
	Dim Indice
	Dim Caracter
	Dim Largo
	Dim Estado
	ValidarEMAIL = vbEMailNulo ' Inicialmente lo suponemos vacío 
	If EMAIL <> "" Then
		Largo = Len(EMAIL)
		Estado = 0 ' Estado inicial del autómata 
		For Indice = 1 To Largo ' Comenzamos a recorrer la cadena 
			Caracter = Mid(EMAIL, Indice, 1) ' Vamos tomando carácter a carácter 
			' Con lo que sigue comprobamos si el caracter está 
			' en el rango A-Z , a-z , 0-9 (caracter aceptable tipo A - Alfanumerico) 
			If (Caracter>="a" AND Caracter<="z") OR _ 
			(Caracter>="A" AND Caracter<="Z") OR _
			(Caracter>="0" AND Caracter<="9") Then
				Caracter = "A"
			End If
			' Con lo que sigue comprobamos si el caracter es 
			' _ ó - (caracter aceptable tipo - : Guion alto o bajo) 
			If Caracter = "-" Or Caracter = "_" Then 
				Caracter = "-"
			End If
			Select Case Caracter
				Case "A": ' Es un caracter aceptable tipo A 
					Select Case Estado 
						Case 0:
							Estado = 1 ' Era el primer caracter del EMAIL: pasamos a estado 1 
						Case 1:
							Estado = 1 ' Caracter intermedio ..x.. antes de arroba. Seguimos en 1 
						Case 2:
							Estado = 3 ' Caracter después de arroba. Pasamos a estado 3 
						Case 3:
							Estado = 3 ' Caracter en dominio. Seguimos en estado 3 
						Case 4:
							Estado = 5 ' 1eer caracter en extension de dominio/subdominio. Pasamos a estado 5 
						Case 5:
							Estado = 6 ' 2º caracter en extension de dominio/subdominio. Pasamos a estado 6 
						Case 6:
							Estado = 7 ' 3er caracter en extension de dominio/sudominio. Pasamos a estado 7 
						Case 7:
							Estado = 8 ' 4º caracter en extension de dominio/subdominio. Pasamos a estado 8 
						Case 8:
							ValidarEMAIL = vbEMailNoOK ' La longitud de la extensión .XXXX mayor que 4 caracteres 
							Exit Function ' Estado de error 
					End Select
				Case "-": ' Es un caracter aceptable tipo "-" 
					Select Case Estado 
						Case 1:
							Estado = 1 ' Caracter intermedio ..-.. antes de arroba. Seguimos en 1 
						Case 3:
							Estado = 3 ' Caracter en dominio. Seguimos en estado 3 
						Case Else:
							ValidarEMAIL = vbEMailNoOK  
							Exit Function ' Estado de error 
					End Select 
				Case "." : '-----> Encuentra un punto 
					Select Case Estado
						Case 1: ' Como lo anterior eran caracteres y puntos 
							Estado = 0 ' pasamos a estado inicial (espera un caracter) 
						Case 3: ' Lo anterior era una arroba y texto 
							Estado = 4 ' Pasamos a estado 4 (extension .com, .net, .shop, .info ...) 
						Case 6: ' Estaba en una extensión de dos letras como .ac y encontramos otro punto, para ir a algo como .ac.cr 
							Estado = 4 ' Pasamos a estado 4 (para esperar otra extensión) 
						Case 7: ' Estaba en una extensión de tres letras como .ucr y encontramos otro punto, para ir a algo como .ucr.ac.cr 
							Estado = 4 ' Pasamos a estado 4 (para esperar otra extensión) 
						Case 8: ' Estaba en una extensión de cuatro letras como .info y encontramos otro punto, para ir a algo como .info.cr 
							Estado = 4 ' Pasamos a estado 4 (para esperar otra extensión). 
						Case Else: ' Encontró un punto después de la arroba o al comienzo de la cadena 
							ValidarEMAIL = vbEMailNoOK ' o antes de la arroba 
							Exit Function ' Estado de error 
					End Select
				Case "@": '-----> Encuentra una arroba 
					Select Case Estado
						Case 1: ' Si lo anterior eran caracteres y puntos, 
							Estado = 2 ' pasamos a estado 2 
						Case Else: ' Si lo anterior era algo distinto 
							ValidarEMAIL = vbEMailNoOK ' Estado de error 
							Exit Function
					End Select
				' -----> Encuentra un caracter "raro" 
				Case Else: ' Caracter inaceptable para email. Ej: * : ! 
					ValidarEMAIL = vbEMailNoOK ' Estado de error 
					Exit Function
			End Select
		Next ' -----> Fin de comprobación de cadena 
		If (Estado = 6) or (Estado = 7) or (Estado = 8) Then ' El autómata terminó en un estado final 
			ValidarEMAIL = vbEMailOK ' Estado final: email correcto 
		Else
			ValidarEMail = vbEMailNoOK ' No era un estado final: email incorrecto
		End If
	End If 
End Function