4

我正在寻找在 VBA 中验证发送到 Outlook 电子邮件的值

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

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

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

是否可以验证值，例如1@1.com; 2@1.com使用 VBA？

4

3 回答 3

8

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

考虑以下几行：

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
于 2018-08-13T11:00:36.927 回答
2

使用该Split()函数将字符串拆分为单独的地址，并使用您的函数在循环中检查这些地址。

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

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

于 2018-08-13T10:38:19.133 回答
2

要使用正则表达式验证多个电子邮件 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
于 2018-08-13T10:50:45.030 回答