Vba 如何设置具有动态日期的电子邮件模板，或者创建宏以插入日期？

我有一个每周发送的报告模板，在四个不同的位置（三个在正文中，一个在主题行）有一个与前一周的星期一相对应的日期。（基本上，这是我报告的那一周的“一周”，总是前一周。）

我想在光标所在的位置添加一个日期。（如果我能在模板中为我想要添加日期的地方设置书签，那就更好了。）我已经做了很多关于插入文本的研究，我一直遇到两个相同的问题：

我可以编写一个宏来打开一条新消息并填充各个区域（主题行、正文等），但我无法让该宏仅处理我已经打开的消息

对于我已经打开的消息上实际运行的所有示例，我只能让它在正文中添加文本。我希望创造一些简单的东西，比如Word的功能：

Selection.TypeText Text:="Hello!"

这些方法都不适合我

---

*编辑#1:当然，在我发布这篇文章之后，我发现我找到的一个解决方案就是在光标所在的位置添加文本，现在可以使用了

TypeName(Application.ActiveWindow) = "Inspector" Then
    SendKeys Format(Now, "MMMM dd, yyyy")
    DoEvents
End If

如果我坚持使用这种方法，我只需要知道如何设置它，以便它插入前一周星期一的日期，而不是今天的日期（我不总是在同一天运行报告，所以我不能告诉它从今天的日期减去八天）。我还想知道我是否可以告诉它通过查找/替换之类的操作将该日期插入多个位置

---

*编辑#2:我还遇到了一个不错的例子，可以快速找到/替换身体。唯一的问题是，它完全删除了所有格式，包括表格、颜色等

Dim Insp As Inspector
Dim obj As Object

    Set Insp = Application.ActiveInspector
    Set obj = Insp.CurrentItem

    obj.Body = Replace(obj.Body, "xxxxxxxxxx", Format(Now - 8, "MMMM dd, yyyy"))

    Set obj = Nothing
    Set Insp = Nothing

---

（你可能还注意到我在日期格式中添加了一个

-8

。我想如果我不能让它始终添加我要查找的确切日期，我至少可以接近它。）

由于我是移动的，我现在无法发布就绪代码，但我相信你可以通过两个提示自己解决这个问题： 对于格式问题，请使用.htmlbody而不是body 对于上周的星期一，使用datediff；从今天开始减去7天再加上今天的工作日数

我希望这有帮助，

---

Max

我还没有找到完美的答案，但我已经找到了一个非常可行的解决方案，所以我想我会分享它，以防将来有人遇到同样的问题

首先，@Sorceri要求查看我用来生成电子邮件的代码，因此它是：

就像我之前说的，它只是启动一个我事先创建的电子邮件模板

现在，我使用以下代码在主体中执行查找/替换（我刚刚找到并调整了它以满足我的需要）：

我觉得有些可能有些过分，但它运行得很完美。因为这只在主体上进行查找/替换，所以我在后面添加了以下内容以处理主题行。

它并不完美，我相信它可以以某种方式进行优化，以便第一次查找/替换处理正文和主题行，但我对结果非常满意

---

我只希望我能了解更多关于日期格式的知识，这样我就可以把日期输入到前一周的星期一，而不是仅仅倒数八天。

这里有一个快速简单的方法来替换电子邮件中的文本。我认为唯一的问题可能是计算星期一的日期。我会在一分钟内更新

Sub ReportProduction()
Dim myTemplate As Outlook.MailItem
    Set myTemplate = Application.CreateItemFromTemplate(Environ("Appdata") & _
        "\Microsoft\Templates\ReportProduction.oft")
    myTemplate.HTMLBody = Replace(myTemplate.HTMLBody, "xxxxxxxxxxxxxxx", Format(Now + DaysUntilMonday - 7, "MMMM dd, yyyy"))
    myTemplate.Subject = Replace(myTemplate.Subject, "xxxxxxxxxxxxxxx", Format(Now + DaysUntilMonday - 7, "MMMM dd, yyyy"))
    myTemplate.Display
    Set myTemplate = Nothing
End Sub

我采用了下面的方法，因为它计算了未来的星期一并使用了它，这是我已经拥有的代码。 它使用的格式是（现在+daysuntilmanday-7，“MMMM-dd，yyyy”），所以得到下一个星期一，然后减去7得到上一个星期一。不过，该代码可以修改为一次性计算上一个星期一

Function DaysUntilMonday() As Integer
Dim currentDay As Integer
Dim retVal As Integer
currentDay = DatePart("w", DateTime.Now)
    If currentDay = vbSunday Then 'vbSunday 1 Sunday (default)
        retVal = 1
    ElseIf currentDay = vbMonday Then 'vbMonday 2 Monday
        retVal = 7
    ElseIf currentDay = vbTuesday Then 'vbTuesday 3 Tuesday
        retVal = 6
    ElseIf currentDay = vbWednesday Then 'vbWednesday 4 Wednesday
        retVal = 5
    ElseIf currentDay = vbThursday Then 'vbThursday 5 Thursday
        retVal = 4
    ElseIf currentDay = vbFriday Then 'vbFriday 6 Friday
        retVal = 3
    ElseIf currentDay = vbSaturday Then 'vbSaturday 7 Saturday
        retVal = 2
    End If
DaysUntilMonday = retVal
End Function

---

我终于找到了如何插入所需的确切日期，并将其简化为一个简单的宏，用于打开模板并将正文和主题行中的日期更改为前一周星期一的日期。由于这个解决方案完成了我最初希望完成的所有任务，我想我应该创建一个新的答案。我担心删除或编辑之前的答案，因为有人可能仍然发现它的信息有用。不用多说，下面是我现在使用的代码：

我还需要添加以下功能：

---

很高兴看到生成电子邮件的完整代码。为什么需要使用sendkeys？如果您从模板创建电子邮件，您应该能够引用邮件项，并使用它访问正文、主题和所有其他字段。我对Word VBA有多年的经验，但我确实是Outlook的初学者，因此我真的无法回答您的问题，即我为什么要使用

SendKeys

，除了说我在网上找到了这个例子并对它进行了调整之外。至于生成电子邮件的代码，其实没什么特别的。我刚刚创建了一封包含一些文本、表格和签名的电子邮件，并将其保存为模板。宏只是打开该模板，这样我就可以手动填充空格并点击Send。您是在outlook中运行此操作，还是在Excel中运行vbscript？如果Max没有先找到一些示例代码，我将在稍后发布一些示例代码。谢谢，@Sorceri，我完全在Outlook中运行这些代码。如果你看看我刚才发布的答案，我想我使用了不同的查找/替换方法解决了第一个问题，因此格式不再是问题。关于约会，我知道你在说什么，但我不知道如何编写代码。更具体地说，我不知道如何获得今天的工作日数。在尝试了您关于使用.htmlbody的建议后，我甚至比我在下面发布的查找/替换方法更喜欢这种方法，因为代码非常简单

Dim Insp As Inspector
Dim obj As Object

    Set Insp = Application.ActiveInspector
    Set obj = Insp.CurrentItem

    obj.Subject = Replace(obj.Subject, "xxxxxxxxxxxxxxx", _
        Format(Now - 8, "MMMM dd, yyyy"))

    Set obj = Nothing
    Set Insp = Nothing

Sub ReportProduction()
Dim myTemplate As Outlook.MailItem
    Set myTemplate = Application.CreateItemFromTemplate(Environ("Appdata") & _
        "\Microsoft\Templates\ReportProduction.oft")
    myTemplate.HTMLBody = Replace(myTemplate.HTMLBody, "xxxxxxxxxxxxxxx", Format(Now + DaysUntilMonday - 7, "MMMM dd, yyyy"))
    myTemplate.Subject = Replace(myTemplate.Subject, "xxxxxxxxxxxxxxx", Format(Now + DaysUntilMonday - 7, "MMMM dd, yyyy"))
    myTemplate.Display
    Set myTemplate = Nothing
End Sub

Function DaysUntilMonday() As Integer
Dim currentDay As Integer
Dim retVal As Integer
currentDay = DatePart("w", DateTime.Now)
    If currentDay = vbSunday Then 'vbSunday 1 Sunday (default)
        retVal = 1
    ElseIf currentDay = vbMonday Then 'vbMonday 2 Monday
        retVal = 7
    ElseIf currentDay = vbTuesday Then 'vbTuesday 3 Tuesday
        retVal = 6
    ElseIf currentDay = vbWednesday Then 'vbWednesday 4 Wednesday
        retVal = 5
    ElseIf currentDay = vbThursday Then 'vbThursday 5 Thursday
        retVal = 4
    ElseIf currentDay = vbFriday Then 'vbFriday 6 Friday
        retVal = 3
    ElseIf currentDay = vbSaturday Then 'vbSaturday 7 Saturday
        retVal = 2
    End If
DaysUntilMonday = retVal
End Function

Sub ReportProduction()
Dim StartDay_of_LastWeek As String
Dim Insp As Inspector
Dim obj As Object
Dim myTemplate As Outlook.MailItem
StartDay_of_LastWeek = Format(GetWeekStartDate(CDate(Now - 7), vbMonday), _
    "MMMM dd, yyyy")
Set myTemplate = Application.CreateItemFromTemplate(Environ("Appdata") _
    & "\Microsoft\Templates\ReportProduction.oft")

    myTemplate.Display

    Set Insp = Application.ActiveInspector
    Set obj = Insp.CurrentItem

    obj.HTMLBody = Replace(obj.HTMLBody, "xxxxxxxxxxxxxxx", StartDay_of_LastWeek)
    obj.Subject = Replace(obj.Subject, "xxxxxxxxxxxxxxx", StartDay_of_LastWeek)

    Set obj = Nothing
    Set Insp = Nothing

End Sub

Function GetWeekStartDate(ByVal strDate, _
    Optional ByVal lngStartDay As Long = 2) As String
GetWeekStartDate = DateAdd("d", -Weekday(CDate(strDate), _
    lngStartDay) + 1, CDate(strDate))
End Function