如何用VBA/Macro实现Outlook每月最后周三前2天自动发送重复邮件？

完全可以用VBA实现这个需求，不管是在Outlook里直接写宏，还是通过Excel触发Outlook发送邮件都能搞定。下面是具体实现方案：

核心逻辑：计算目标发送日期 #

要找到当月最后一个周三，再往前推2天就是需要发送邮件的周一。用VBA日期函数可以快速计算：

Function GetSendDate() As Date
    Dim lastDayOfMonth As Date
    Dim lastWednesday As Date
    
    ' 获取当月最后一天
    lastDayOfMonth = DateSerial(Year(Date), Month(Date) + 1, 0)
    ' 倒推找到当月最后一个周三（vbWednesday=4）
    lastWednesday = lastDayOfMonth - ((lastDayOfMonth - vbWednesday + 7) Mod 7)
    ' 发送日期是最后周三前2天（周一）
    GetSendDate = lastWednesday - 2
End Function

完整发送邮件的VBA代码（以Outlook为例） #

打开Outlook，按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码：

Sub AutoSendReminderEmail()
    Dim sendDate As Date
    Dim olApp As Object
    Dim olMail As Object
    
    ' 获取今天的日期和目标发送日期，非目标日期直接退出
    sendDate = GetSendDate()
    If Date <> sendDate Then Exit Sub
    
    ' 初始化Outlook对象
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    ' 创建并配置邮件
    Set olMail = olApp.CreateItem(0) ' 0代表普通邮件项
    With olMail
        .To = "收件人邮箱@example.com" ' 替换为实际收件人地址
        .CC = "抄送人邮箱@example.com" ' 可选，不需要可删除此行
        .Subject = "月度事项提醒：请于本月最后周三前回复"
        .Body = "您好：" & vbCrLf & vbCrLf & _
                "请于本月最后一个周三（" & Format(sendDate + 2, "yyyy年mm月dd日") & "）前完成相关事项并回复本邮件。" & vbCrLf & vbCrLf & _
                "感谢配合！"
        ' 若需HTML格式邮件，将.Body替换为.HTMLBody = "你的HTML内容"
        .Send ' 直接发送，用.Display可先预览再手动发送
    End With
    
    ' 释放对象资源
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

Function GetSendDate() As Date
    Dim lastDayOfMonth As Date
    Dim lastWednesday As Date
    
    lastDayOfMonth = DateSerial(Year(Date), Month(Date) + 1, 0)
    lastWednesday = lastDayOfMonth - ((lastDayOfMonth - vbWednesday + 7) Mod 7)
    GetSendDate = lastWednesday - 2
End Function

设置自动运行 #

方法1：Outlook规则触发 #

• 打开Outlook的「规则和通知」，新建规则选择「从空白规则开始」→「对我接收的邮件应用规则」
• 添加条件：选择「个人或公共组」并指定自己的邮箱（用于触发规则），再添加操作「运行脚本」，选择上面的AutoSendReminderEmail宏
• 最后设置规则每日运行（比如每天上午9点触发检查）

方法2：Windows任务计划调用 #

• 把上述代码放到Excel宏里（逻辑一致），保存为启用宏的工作簿
• 打开Windows任务计划，创建每日任务，触发时间设为每天上午9点，操作选择「启动程序」，路径填Excel安装路径（如C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE），参数填/r "D:\你的宏文件路径\AutoSendEmail.xlsm"

方法3：Excel宏定时触发 #

• 在Excel的ThisWorkbook模块中添加以下代码，打开工作簿时设置每日9点检查发送：

  Private Sub Workbook_Open()
      Application.OnTime TimeValue("09:00:00"), "AutoSendReminderEmail"
  End Sub
  

• 注意需保持Excel处于打开状态才能触发

注意事项 #

• 确保Outlook启用宏：文件→选项→信任中心→信任中心设置→宏设置，选择「启用所有宏」或「通知所有宏」
• 首次运行可能弹出安全提示，需允许宏运行
• 测试时可临时注释If Date <> sendDate Then Exit Sub这一行，强制发送邮件验证内容

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