如何在Outlook中实现自动填充含日期的邮件？Word宏迁移

手动运行宏填充当前邮件 #

先创建一个可手动触发的宏，用于给当前打开的邮件填充指定格式的日期内容：

1. 打开Outlook，按Alt+F11打开VBA编辑器
2. 在左侧项目窗格中右键点击VBAProject(Outlook)，选择「插入」→「模块」
3. 将以下代码粘贴到模块中：

Sub FillWeekDateInEmail()
    Dim objMail As MailItem
    Dim firstDay As Date
    Dim lastDay As Date
    Dim emailBody As String
    
    ' 获取当前正在编辑的邮件对象
    Set objMail = ActiveInspector.CurrentItem
    
    ' 计算当周周一日期（以周一为一周起始）
    firstDay = Date - (Weekday(Date, vbMonday) - 1)
    ' 若要固定填充到周五，把下面的Date改成 firstDay + 4
    lastDay = Date
    
    ' 构建符合需求的邮件正文
    emailBody = "您好，" & vbCrLf & _
                "现将本周" & Format(firstDay, "yyyy年mm月dd日") & "至" & Format(lastDay, "yyyy年mm月dd日") & "的相关报告发送给您。" & vbCrLf & _
                "此致"
    
    ' 赋值给纯文本正文；如果用HTML格式，替换为 objMail.HTMLBody = emailBody
    objMail.Body = emailBody
End Sub

使用方法：

• 打开新邮件或编辑已有邮件
• 按Alt+F8调出宏选择窗口，选中FillWeekDateInEmail并点击「运行」
• 也可以把宏添加到Outlook快速访问工具栏，一键触发

新建邮件时自动填充正文 #

如果需要每次新建邮件时自动生成该内容，在ThisOutlookSession中添加以下代码：

1. 在VBA编辑器左侧双击ThisOutlookSession
2. 粘贴以下代码：

Private Sub Application_ItemLoad(ByVal Item As Object)
    Dim objMail As MailItem
    Dim firstDay As Date
    Dim lastDay As Date
    Dim emailBody As String
    
    ' 仅对邮件对象生效
    If TypeName(Item) = "MailItem" Then
        Set objMail = Item
        ' 仅在新建空白邮件时触发（排除回复/转发邮件）
        If objMail.EntryID = "" Then
            firstDay = Date - (Weekday(Date, vbMonday) - 1)
            lastDay = Date
            emailBody = "您好，" & vbCrLf & _
                        "现将本周" & Format(firstDay, "yyyy年mm月dd日") & "至" & Format(lastDay, "yyyy年mm月dd日") & "的相关报告发送给您。" & vbCrLf & _
                        "此致"
            objMail.Body = emailBody
        End If
    End If
End Sub

注意事项 #

• 启用宏功能：依次点击「文件」→「选项」→「信任中心」→「信任中心设置」→「宏设置」，选择「启用所有宏」（或对应安全级别的选项）
• 若使用HTML格式邮件，需将代码中的vbCrLf替换为<br>，并把objMail.Body改为objMail.HTMLBody

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