Outlook VBA如何提取指定域名客户邮箱并触发模板自动回复

修改说明 #

• 针对正则匹配错误问题：
  1. 调整正则规则，仅匹配你指定的客户统一域名，同时可增加「邮箱：」前缀匹配逻辑，彻底避开正文开头的support客服邮箱，不会出现误匹配
  2. 你只需要把代码中的@你的指定域名\.com替换成实际的客户统一域名即可，比如客户邮箱都是@xyz.com就改成@xyz\.com
• 针对主题不符合需求问题：
  代码中提供了自定义主题的示例，你可以根据业务需要自由调整主题格式，支持固定主题、原主题加自定义前缀等多种形式

完整修改后代码 #

Sub SendNew(Item As Outlook.MailItem)
    Dim Reg1 As Object
    Dim M1 As Object
    Dim strAddress As String
 
    Set Reg1 = CreateObject("VBScript.RegExp")
    With Reg1
        ' 匹配「邮箱：」后跟着的指定域名邮箱，彻底规避开头的support邮箱
        .Pattern = "邮箱：\s*([\w-\.]+@你的指定域名\.com)"
        .IgnoreCase = True
        .Global = False ' 单份通知仅一个客户邮箱，不需要全局匹配
    End With

    ' 未匹配到合规邮箱时提示并退出，避免发错邮件
    If Not Reg1.Test(Item.Body) Then
        MsgBox "未找到符合规则的客户邮箱，请手动检查", vbExclamation
        Exit Sub
    End If
    
    Set M1 = Reg1.Execute(Item.Body)
    strAddress = M1(0).SubMatches(0)

    Dim objMsg As MailItem
    Set objMsg = Application.CreateItemFromTemplate("C:\Users\---\AppData\Roaming\Microsoft\Templates\can.oft")
    objMsg.Recipients.Add strAddress
    
    ' 自定义主题，可按需修改，比如固定主题就直接赋值固定字符串即可
    objMsg.Subject = "预订取消确认：" & Item.Subject
 
    ' 测试阶段使用，验证没问题后替换为 objMsg.Send 即可自动发送
    objMsg.Display
End Sub

可选适配方案 #

如果你的邮件正文中客户邮箱前没有固定的「邮箱：」前缀，只想通过域名过滤，可把正则部分替换为如下代码，会自动跳过开头的support邮箱，取最后一个符合域名规则的客户邮箱：

With Reg1
    .Pattern = "([\w-\.]+@你的指定域名\.com)"
    .IgnoreCase = True
    .Global = True ' 开启全局匹配所有符合域名的邮箱
End With

If Reg1.Test(Item.Body) Then
    Set M1 = Reg1.Execute(Item.Body)
    ' 取最后一个符合规则的邮箱，避开最前面的support客服邮箱
    strAddress = M1(M1.Count - 1).SubMatches(0)
End If

内容的提问来源于stack exchange，提问作者Mema