Here's some code I adapted from two seperate threads at MrExcel's forum to check whether an email address is valid email pattern, i.e. This email address is being protected from spambots. You need JavaScript enabled to view it., AND also if the domain is valid.
IsEmailAddress("This email address is being protected from spambots. You need JavaScript enabled to view it.") = TRUE
IsEmailAddress("me@test@com") = FALSE
IsEmailAddress("This email address is being protected from spambots. You need JavaScript enabled to view it.") = FALSE
IsURL("http://test.com") = TRUE
IsURL("http://test.xom") = FALSE
VBA Code
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. This email address is being protected from spambots. You need JavaScript enabled to view it.
'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
Links
- MrExecel forum: VBA Textbox email Validation - https://www.mrexcel.com/forum/excel-questions/268673-vba-textbox-email-validation.html
- MrExecel forum: Check if URL exists, is so then return true - https://www.mrexcel.com/forum/excel-questions/567315-check-if-url-exists-so-then-return-true.html
- Regular Expression Language - Quick Reference - https://docs.microsoft.com/en-us/dotnet/standard/base-types/regular-expression-language-quick-reference
- VBScript RegExp Example: Regular Expression Tester - https://www.regular-expressions.info/vbscriptexample.html