Validate Email Address in VBA (Visual Basic for Applications)

Email Address

If you are struggling to validate an email address using VBA code you can simply follow any of the approach given below.

ValidateEmail

Public Sub CheckAndValidateEmailAddress()
    Dim txtEmail As String
    txtEmail = InputBox("Enter Email Address:", "E-Mail Address")
     ' Check e-mail syntax
    If IsEmailValid(txtEmail) Then
        MsgBox txtEmail & " is a valid e-mail"
    Else
        MsgBox txtEmail & " is not a valid e-mail"
    End If
End Sub

IsValidEmail Method

Public Function IsEmailValid(strEmail As String) As Boolean
    Dim strArray As Variant
    Dim strItem As Variant
    Dim i As Long
    Dim c As String
    Dim blnIsItValid As Boolean
    blnIsItValid = True
     
    i = Len(strEmail) - Len(Application.Substitute(strEmail, "@", ""))
    If i <> 1 Then IsEmailValid = False: Exit Function
    ReDim strArray(1 To 2)
    strArray(1) = Left(strEmail, InStr(1, strEmail, "@", 1) - 1)
    strArray(2) = Application.Substitute(Right(strEmail, Len(strEmail) - Len(strArray(1))), "@", "")
    For Each strItem In strArray
        If Len(strItem) <= 0 Then
            blnIsItValid = False
            IsEmailValid = blnIsItValid
            Exit Function
        End If
        For i = 1 To Len(strItem)
            c = LCase(Mid(strItem, i, 1))
            If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
                blnIsItValid = False
                IsEmailValid = blnIsItValid
                Exit Function
            End If
        Next i
        If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then
            blnIsItValid = False
            IsEmailValid = blnIsItValid
            Exit Function
        End If
    Next strItem
    If InStr(strArray(2), ".") <= 0 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    i = Len(strArray(2)) - InStrRev(strArray(2), ".")
    If i <> 2 And i <> 3 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    If InStr(strEmail, "..") > 0 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    IsEmailValid = blnIsItValid
End Function

Regular Expression

To validate a mail we can use another method which provides short code to achieve same goal mentioned in previous example. RegExp is a scripting library provided by Microsoft which we need to bring in our project by adding as reference as shown below:

Code example

Public Sub CheckEmailUsingRegExp()
    Dim vMailAddress As String
    vMailAddress = InputBox("Enter Email Address:", "E-Mail Address")
     ' Check e-mail syntax
    If IsEmailAddressValid(vMailAddress) Then
        MsgBox vMailAddress & " is a valid e-mail"
    Else
        MsgBox vMailAddress & " is not a valid e-mail"
    End If
End Sub

IsEmailAddressValid Function

Public Function IsEmailAddressValid(ByVal strEmailAddress As String) As Boolean
    On Error GoTo Errh
    
    Dim objRegExp As New RegExp
    Dim blnIsValidEmail As Boolean
    
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
    
    blnIsValidEmail = objRegExp.Test(strEmailAddress)
    IsEmailValid = blnIsValidEmail
      
    Exit Function
    
Errh:
    If Err.Number <> 0 Then
    IsEmailValid = False
        MsgBox "Error#:  " & Err.Number & vbCrLf & vbCrLf & Err.Description
    End If
End Function

Please leave your comments or queries under comment section also please do subscribe to out blogs to keep your self upto date.

Share on Facebook

Tweet