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

Posted 2023-02-25

【中文标题】如何设置具有动态日期的电子邮件模板，或者创建一个宏来插入日期？

【英文标题】：How do I set up an email template with dynamic dates or alternatively, create a macro to insert a date?

【发布时间】：2013-11-11 17:55:48

【问题描述】：

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

我想在光标所在的位置添加一个日期。 （如果我能以某种方式在模板中为我想要添加日期的位置设置书签，那就更好了。）我已经对插入文本进行了大量研究，并且在我的示例中一直遇到同样的两个问题'一直在寻找：

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

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

Selection.TypeText Text:="Hello!"

这些方法都不适合我。

---

*edit #1：当然，在我发布这个之后，我发现我发现的一种解决方案是简单地将文本添加到光标现在所在的位置。

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

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

---

*edit #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。我想如果我不能让它总是添加我正在寻找的确切日期，我至少可以让它接近。）

【问题讨论】：

很高兴看到生成电子邮件的整个代码。为什么需要使用 sendkeys？如果您从模板创建电子邮件，您应该能够引用邮件项并使用它来访问正文、主题和所有其他字段。

我有多年的 Word VBA 经验，但我确实是 Outlook 的初学者，所以我真的无法回答你关于我为什么要使用 SendKeys 之类的问题，其他而不是说我在网上找到了这个例子并对其进行了调整。至于生成电子邮件的代码，它真的没什么特别的。我刚刚创建了一封包含一些文本、表格和我的签名的电子邮件，并将其保存为模板。宏只是打开该模板，以便我可以手动填写空白并点击发送。

您是在 Outlook 中还是在 Excel（vbscript）中运行此程序？如果 Max 没有先写，我会在稍后发布一些示例代码。

谢谢，@Sorceri，我完全在 Outlook 中运行它。

【参考方案1】：

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

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

我采用了下面的方法，因为它计算未来星期一并使用它，这是我已经拥有的代码。 它被使用，例如 Format(Now + DaysUntilMonday - 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

【讨论】：

主题正在更新，但不是 HTMLBody。我现在可以解释原因吗

【参考方案2】：

由于是移动设备，我目前无法发布准备好的代码，但我相信您可以通过两个提示自行解决此问题： 对于格式问题，使用 .htmlbody 而不是 body 上周星期一使用 datediff；从今天开始减去 7 天加上今天的工作天数。

我希望这会有所帮助， 最大

【讨论】：

如果您看一下我刚刚发布的答案，我想我使用不同的查找/替换方法解决了第一个问题，因此格式不再是问题。对于日期，我知道您在说什么，但我不知道如何编写该代码。更具体地说，我不知道如何获得今天的工作日数。

在尝试了使用 .htmlbody 的建议后，我更喜欢这种方法，甚至比我在下面发布的查找/替换方法更好，因为代码更简单。与查找/替换方法不同，这不会让您在运行它时撤消它所做的更改......我最初认为这是一个错误，但我现在意识到这是一个功能。如果我将该代码添加到打开我的模板的宏的末尾，它会快速添加日期而不让我撤消任何操作，因此看起来日期一直是模板的一部分。我仍然不知道如何获得今天的工作日数，但这是一个很好的开始。

【参考方案3】：

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

首先，@Sorceri 要求查看我用来生成电子邮件的代码，所以这里是：

Sub ReportProduction()
Dim myTemplate As Outlook.MailItem
Set myTemplate = Application.CreateItemFromTemplate(Environ("Appdata") & _
    "\Microsoft\Templates\ReportProduction.oft")
myTemplate.Display
End Sub

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

现在我使用以下代码在正文中进行查找/替换（我刚刚找到并调整了以适应我的需要）：

Dim myInspector As Outlook.Inspector
Dim myObject As Object
Dim myItem As Outlook.MailItem
Dim myDoc As Word.Document
Dim mySelection As Word.Selection
Dim strItem, strGreeting As String

Set myInspector = Application.ActiveInspector
Set myObject = myInspector.CurrentItem

'The active inspector is displaying a mail item.
If myObject.MessageClass = "IPM.Note" And myInspector.IsWordMail = True Then
    Set myItem = myInspector.CurrentItem
    'Grab the body of the message using a Word Document object.
    Set myDoc = myInspector.WordEditor
    myDoc.Range.Find.ClearFormatting
    Set mySelection = myDoc.Application.Selection
    With mySelection.Find
        .Text = "xxxxxxxxxxxxxxx"
        .Replacement.Text = Format(Now - 8, "MMMM dd, yyyy")
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    If mySelection.Find.Execute = True Then
        mySelection.Find.Execute Replace:=wdReplaceAll
    End If
End If

我觉得其中一些可能有点矫枉过正，但它运行完美。因为这只在正文上进行查找/替换，所以我后来添加了以下内容来处理主题行。

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

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

我只是希望我对日期格式有更多了解，这样我就可以让它进入前一周的星期一，而不是仅仅倒数八天。

【参考方案4】：

我终于弄清楚了如何插入我需要的确切日期，并且我已将其简化为一个简单的宏，该宏打开模板并将正文和主题行中的日期更改为前一周星期一的日期。由于这个解决方案完成了我最初想要完成的所有事情，我想我应该创建一个新的答案。我担心删除或编辑以前的答案，因为有人可能仍然会发现它的信息有用。事不宜迟，这是我现在使用的代码：

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

【讨论】：

看看我发布的内容，你还有一些你不需要的东西，比如检查员。