如何在Outlook中自动格式化时间、货币值与电话号码？

核心结论 #

• 可以实现自动格式化时间、货币、电话号码，正则表达式是最优方案——这类内容有明确的格式规律，正则能精准匹配目标文本。
• 要让功能同时在ActiveExplorer（邮件列表窗口）和ActiveInspector（邮件编辑/查看窗口）生效，需要先判断当前激活的窗口类型，再获取对应的邮件对象。

改进后的代码 #

以下代码支持：

• 匹配并加粗12小时制时间（如10:24 am、03:15 PM）
• 匹配并加粗多种货币（如$123、€45.67、¥8901、£1,234.56）
• 匹配并加粗常见格式的电话号码（如(123) 456-7890、123-456-7890、+1 123 4567890）
• 同时兼容ActiveExplorer和ActiveInspector窗口
• 智能识别签名区域（找不到签名时直接处理整个正文）

Sub AutoFormatText()
    Dim regExp As Object
    Set regExp = CreateObject("vbscript.regexp")
    regExp.Global = True
    regExp.IgnoreCase = True ' 忽略大小写，适配AM/PM等场景
    
    Dim targetItem As Object
    ' 判断当前激活窗口，获取目标邮件
    If Not Application.ActiveInspector Is Nothing Then
        Set targetItem = Application.ActiveInspector.CurrentItem
    ElseIf Application.ActiveExplorer.Selection.Count > 0 Then
        Set targetItem = Application.ActiveExplorer.Selection(1)
    Else
        MsgBox "请选中一封邮件或打开邮件编辑窗口", vbExclamation
        Exit Sub
    End If
    
    ' 仅处理邮件类型对象
    If Not TypeOf targetItem Is Outlook.MailItem Then
        MsgBox "此功能仅支持邮件对象", vbExclamation
        Exit Sub
    End If
    
    Dim bodyHTML As String
    bodyHTML = targetItem.HTMLBody
    Dim modifiedBody As String
    
    ' 识别签名位置（适配Outlook自带标记和常见问候语）
    Dim signaturePos As Long
    signaturePos = InStr(1, bodyHTML, "<div class=""WordSection1""") ' Outlook签名默认标记
    If signaturePos = 0 Then signaturePos = InStr(1, bodyHTML, "Best,")
    If signaturePos = 0 Then signaturePos = InStr(1, bodyHTML, "Regards,")
    If signaturePos = 0 Then signaturePos = Len(bodyHTML) + 1 ' 找不到签名则处理全部内容
    
    ' 提取签名上方的正文部分
    modifiedBody = Left(bodyHTML, signaturePos - 1)
    
    ' 1. 匹配并加粗12小时制时间
    regExp.Pattern = "\b([01]?\d):([0-5]\d)\s*(am|pm)\b"
    modifiedBody = regExp.Replace(modifiedBody, "<b>$1:$2 $3</b>")
    
    ' 2. 匹配并加粗多种货币格式
    regExp.Pattern = "\b([$€¥£])\s?(\d{1,3}(,\d{3})*(\.\d{2})?)\b"
    modifiedBody = regExp.Replace(modifiedBody, "<b>$1$2</b>")
    
    ' 3. 匹配并加粗常见电话号码格式
    regExp.Pattern = "\b(\+?\d{1,3})?\s?(\(\d{3}\)|\d{3})[-.\s]?\d{3}[-.\s]?\d{4}\b"
    modifiedBody = regExp.Replace(modifiedBody, "<b>$&</b>")
    
    ' 合并修改后的正文与签名
    targetItem.HTMLBody = modifiedBody & Mid(bodyHTML, signaturePos)
    targetItem.Save ' 保存修改（针对已打开的邮件）
    MsgBox "格式化完成", vbInformation
End Sub

关键说明 #

1. 窗口兼容逻辑：

   • 优先检查ActiveInspector（打开的邮件窗口），获取当前编辑/查看的邮件
   • 若未打开邮件窗口，则读取ActiveExplorer中选中的第一封邮件
   • 无有效邮件时提示用户操作

2. 正则模式适配：

   • 时间：匹配1-12点+00-59分+am/pm组合，忽略大小写
   • 货币：支持$、€、¥、£四种常用货币符号，适配带千分位逗号和两位小数的格式
   • 电话号码：兼容国际区号、括号区号、横杠/空格分隔的主流格式

3. 签名处理优化：

   • 优先识别Outlook签名自带的HTML标记，其次匹配常见签名问候语
   • 找不到签名时自动处理整个邮件正文，避免遗漏内容

4. 扩展提示：

   • 若需避免重复加粗已格式化内容，可在正则中添加排除<b>标签的逻辑
   • 可根据自身需求调整正则模式，适配更多特殊格式的时间、货币或电话号码

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