Comprobar dirección de correo

[xavi]

Palabras clave: correo, dirección, email, valido
Autor: Rubén Vigón

Para comprobar que una direccion MAIL es valida.

Código:

Public Function IsEmail(ByVal strEmail As String) As Boolean
Dim strTemp As String
If Not InStr(strEmail, "@") > 0 Then
    IsEmail = False
   Else
    If Not InStr(strEmail, ".") > 0 Then
        IsEmail = False
       Else
        If Not Len(left(strEmail, InStr(strEmail, "@") - 1)) >= 3 Then
            IsEmail = False
           Else
            strTemp = Mid(strEmail, InStr(strEmail, "@") + 1, Len(strEmail))
            If Not Len(left(strTemp, InStr(strTemp, ".") - 1)) >= 3 Then
                IsEmail = False
               Else
                If Not Len(right(strTemp, Len(strTemp) - InStr(strTemp, "."))) >= 2 Then
                    IsEmail = False
                   Else
                    IsEmail = True
                End If
            End If
        End If
    End If
End If
End Function

[xavi]

A raíz de un problema con ciertas direcciones de correo del estilo nombre.apellido@es.dominio.com, he modificado ligeramente la función. Ha salido esto:

Código:

Public Function IsEmail2(ByVal strEmail As String) As Boolean
    ' Adaptación de Xavi de la función de Rubén Vigón
   
    Dim strTemp As String
    ' verificamos que contiene un @
    If Not InStr(strEmail, "@") > 0 Then
        ' si no lo contiene no es válido
        IsEmail2 = False
       Else
        ' verificamos que no contiene un segundo @
        If InStr(InStr(strEmail, "@") + 1, strEmail, "@") > 0 Then
            IsEmail2 = False
           Else
            strTemp = Mid(strEmail, InStr(strEmail, "@"), Len(strEmail))
            ' lo contiene. verificamos si contiene un punto despues del @
            If Not InStr(strTemp, ".") > 0 Then
                ' si no lo contiene no es válido
                IsEmail2 = False
               Else
                ' lo contiene, verifiquemos que, por detrás del último punto, existen al menos dos caracteres
                If Len(strEmail) - InStrRev(strEmail, ".") < 2 Then
                    IsEmail2 = False
                   Else
                    IsEmail2 = True
                End If
            End If
        End If
    End If
End Function