Validating email To field value in VBA - ms-access

Question

I am looking to validate values sent to an Outlook email in VBA
I have found several examples, such as :-
http://www.geeksengine.com/article/validate-email-vba.html
Using the code from the site above, the email address 1#1.com is returned True, or valid. However, 1#1.com; 2#1.com is returned as invalid. Whilst this isn't a valid email address, it is a valid value for a To field in Outlook.
Is it possible to validate a value such as 1#1.com; 2#1.com using VBA?

Answer 1

Validating an Outlook To field is a hard task.
Consider the following lines:
a#a.com<SomeName;b#b.com 'Valid, 2 addresses, first one named SomeName
a#a<a.com 'Invalid, < needs to be escaped
a#a.com.com;;b#b.com; 'Valid, 2 addresses
a#a.com;a 'Invalid, second address is not valid
a<b#a.com 'Weirdly enough, this is valid according to outlook, mails to b#a.com
'(ignores part before the <)
a#a.com<b#a.com 'But this isn't valid
'(closing > needed in this specific case, mail address = a#a.com)
The only reasonable way to validate an Outlook To field in my opinion, is to check if Outlook thinks it's valid. Any approximation is bound to go wrong.
You can use the following code to let Outlook validate the to string, and check if it can determine a mail address for each field
Public Function IsToValid(ToLine As String) As Boolean
Dim olApp As Object 'Outlook.Application
Dim mail As Object 'Outlook.MailItem
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set mail = olApp.CreateItem(0)
Dim rp As Object 'Outlook.Recipient
With mail
.To = ToLine
.Recipients.ResolveAll
For Each rp In .Recipients
If rp.Address & "" = "" Then
mail.Delete
Exit Function
End If
Next
End With
mail.Delete
IsToValid = True
End Function

Answer 2

Use the Split() function to split the string into the individual addresses, and check these in a loop with your function.
If all addresses are valid, the original string is valid.
The nice thing about it: you don't need separate cases. A single address without ; will return a single array element from Split(), and the loop will simply run once.

Answer 3

To validate multiple email ids using regex use below function:
Public Function ValidateEmailAddress(ByVal strEmailAddress As String) As Boolean
On Error GoTo Catch
Dim objRegExp As New RegExp
Dim blnIsValidEmail As Boolean
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "^((\w+([-+.]\w+)*#\w+([-.]\w+)*\.\w+([-.]\w+)*)\s*[;]{0,1}\s*)+$"
blnIsValidEmail = objRegExp.test(strEmailAddress)
ValidateEmailAddress = blnIsValidEmail
Exit Function
Catch:
ValidateEmailAddress = False
MsgBox "Module: " & MODULE_NAME & " - ValidateEmailAddress function" & vbCrLf & vbCrLf _
& "Error#: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Function