Question

我希望验证在VBA中发送到Outlook电子邮件的值

我发现了几个例子，例如：-

http://www.geeksengine.com/article/validate-email-vba.html

使用来自上面站点的代码，电子邮件地址1@1.com返回True或有效。但是，1@1.com; 2@1.com返回为无效。虽然这不是有效的电子邮件地址，但它是Outlook中“收件人”字段的有效值。

是否可以使用VBA验证诸如1@1.com; 2@1.com之类的值？

Answer 1

验证Outlook To字段是一项艰巨的任务。

请考虑以下几行：

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)

在我看来，验证Outlook To字段的唯一合理方法是检查Outlook是否认为有效。任何近似必然会出错。

您可以使用以下代码让Outlook验证to字符串，并检查它是否可以确定每个字段的邮件地址

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

使用Split()函数将字符串拆分为各个地址，然后使用函数循环检查这些地址。

如果所有地址均有效，则原始字符串有效。

有趣的是：您不需要单独的情况。没有;的单个地址将从Split()返回单个数组元素，并且循环将只运行一次。

Answer 3

要使用正则表达式验证多个电子邮件ID，请使用以下功能：

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

验证VBA中的“电子邮件至”字段值

3 个答案: