http://azlihassan.com/apps/articles/visual-basic-for-applications-vba/vba-check-valid-email

Public Function IsEmailAddress(strEmail As String, Optional blnCheckDomain As Boolean = False) As Boolean

    '*********************************************************************************************************
    'Adapted by Azli Hassan (http://azlihassan.com/apps)
    'Original code from https://www.mrexcel.com/forum/excel-questions/268673-vba-textbox-email-validation.html
    'Function:  Determine if an email address fits an email pattern, e.g. name@domain.com
    'Arguments:
    '   strEmail (String):  Email address to Check
    '   blnCheckDomain (Boolean): Optional, check if email domain is valid.
    '*********************************************************************************************************

    On Error GoTo Err:


    Dim strURL As String

    'Assume is not valid
    IsEmailAddress = False

    'Test if valid or not
    With CreateObject("vbscript.regexp")
        .Pattern = "^[\w-\.]+@([\w-]+\.)+[A-Za-z]{2,4}$"
        IsEmailAddress = .test(strEmail)
    End With

    If IsEmailAddress And blnCheckDomain Then
        strURL = Right(strEmail, Len(strEmail) - InStr(1, strEmail, "@", vbTextCompare))
        IsEmailAddress = IsURL(strURL)
    End If

ExitHere:
    Exit Function

Err:
    'If error occured, assume no valid
    IsEmailAddress = False
    GoTo ExitHere
End Function


Function IsURL(strURL As String) As Boolean

    '********************************************************************************************************
    'Adapted by Azli Hassan (http://azlihassan.com/apps)
    'Original code from
    '     https://www.mrexcel.com/forum/excel-questions/567315-check-if-url-exists-so-then-return-true.html
    'Function:  Determine if an URL address is valid
    'Arguments:
    '   strURL (String):  URL/domain to check
    '********************************************************************************************************

    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo EndNow

    IsURL = False

    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    'Add http if not in strURL string
    If Left(strURL, 4) <> "http" Then
        strURL = "http://" & strURL
    End If

    With Request
      .Open "GET", strURL, False
      .Send
      rc = .StatusText
    End With

    Set Request = Nothing

    If rc = "OK" Then IsURL = True

EndNow:
    Exit Function

End Function