如何合并两段VBA代码实现Outlook邮件评论一键加签名日期并格式化

在Outlook邮件中输入一段评论内容后，自动添加短签名、日期和时间，同时对整段内容格式化，方便收件人识别是添加的邮件备注。

预期效果 #

这是我针对该主题的个人评论 // Signature Tom, 22.08.21, 14:00
（后半部分通过VBA自动添加，整段内容设置为红色斜体）
尊敬的先生/女士
...-> 邮件正文
此致

现有代码说明 #

目前已实现两个独立VBA子程序，需要先后调用两次才能完成操作，希望合并为一个子程序实现一步操作。

子程序1：添加短签名与时间戳 #

Option Explicit
Public Sub AddShortSignature()
    Dim xDoc As Object
    Dim xSel As Object
    
    On Error Resume Next
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
        Case "Inspector"
            Set xDoc = Application.ActiveInspector.WordEditor
    End Select
    
    Set xSel = xDoc.Application.Selection
    xSel.InsertBefore Format(Now, "DD/MM/YYYY hh/mm")
    xSel.InsertBefore Format(" // Tom., ")
    
    Set xDoc = Nothing
    Set xSel = Nothing
    
    SendKeys "{End}", True
    SendKeys "+{Home}", True

End Sub

子程序2：格式化选中内容 #

Sub formateverything()

    Dim objDoc As Object
    Dim objSel As Object
    
    Set objDoc = ActiveInspector.WordEditor
    Set objSel = objDoc.Windows(1).Selection

    objSel.Font.Name = "Arial"
    objSel.Font.Italic = True
    objSel.Font.Bold = False
    objSel.Font.Underline = False
    objSel.Font.Color = RGB(0, 0, 0)
    objSel.Font.Size = 14
    
End Sub

直接整合两段逻辑，同时优化了原代码中不稳定的SendKeys操作，直接通过Word对象模型选中目标内容，执行更可靠：

Option Explicit
Public Sub AddCommentWithSignature()
    Dim xDoc As Object
    Dim xSel As Object
    Dim lStartPos As Long ' 记录输入评论后的起始光标位置
    
    On Error Resume Next
    ' 兼容浏览器窗格和邮件编辑窗口两种场景
    Select Case TypeName(Application.ActiveWindow)
        Case "Explorer"
            Set xDoc = Application.ActiveExplorer.Selection(1).GetInspector.WordEditor
        Case "Inspector"
            Set xDoc = Application.ActiveInspector.WordEditor
    End Select
    If xDoc Is Nothing Then Exit Sub ' 未获取到编辑文档直接退出
    
    Set xSel = xDoc.Application.Selection
    ' 记录当前光标位置（也就是输入完评论的末尾位置）
    lStartPos = xSel.Start
    
    ' 插入签名和时间戳
    xSel.InsertAfter " // Tom., "
    xSel.InsertAfter Format(Now, "DD/MM/YYYY hh:mm")
    
    ' 选中从评论开头到时间戳末尾的整段内容
    xSel.SetRange lStartPos, xSel.End
    
    ' 应用格式化规则，这里把颜色改成了需求要求的红色RGB(255,0,0)，不需要可以改回对应色值
    With xSel.Font
        .Name = "Arial"
        .Italic = True
        .Bold = False
        .Underline = False
        .Color = RGB(255, 0, 0) 
        .Size = 14
    End With
    
    ' 最后把光标移到内容末尾，方便后续输入
    xSel.Collapse Direction:=0 ' wdCollapseEnd
    
    ' 释放对象
    Set xSel = Nothing
    Set xDoc = Nothing
End Sub

使用说明 #

• 输入完自己的评论内容后，直接运行这个宏即可，会自动在评论末尾追加签名、时间，同时把整段评论+签名设置为红色斜体
• 如果不需要红色，把.Color = RGB(255, 0, 0)改成需要的颜色值即可，原代码的黑色是RGB(0,0,0)
• 时间格式如果需要调整，修改Format(Now, "DD/MM/YYYY hh:mm")里的格式字符串即可

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