问题
I have a template for a report I send out every week and in four separate places (three in the body, one in the subject line) is a date that corresponds to the Monday of the prior week. (Basically, it's a "week of" date for the week I'm reporting, which is always the previous week.)
I want to add a date to where I have the cursor. (If I could somehow set up bookmarks in the template for where I want the date added, that would be even better.) I've done a lot of research on inserting text and I keep running into the same two problems with the examples I've been finding:
I can write a macro that will open up a new message and populate various areas (subject line, body, etc.), but I can't get that macro to work on just a message that I already have open.
For all of the examples I've tried that actually run on the message that I already have open, I can only get it to add text to the body. I was hoping to create something simple like how Word does:
Selection.TypeText Text:="Hello!"
None of these approaches have worked for me.
*edit #1: Of course, right after I post this, I find that one of the solutions I found to simply add text to where the cursor is now works.
TypeName(Application.ActiveWindow) = "Inspector" Then
SendKeys Format(Now, "MMMM dd, yyyy")
DoEvents
End If
If I stick with this approach, I just need to know how to set it up so that instead of today's date, it inserts the date from the prior week's Monday (I don't always run the report on the same day, so I can't just tell it to do something simple like subtract eight days from today's date). I'd also like to know if I can tell it to insert that date into multiple places by doing something like a find/replace.
*edit #2: I've also come across a decent example of a quick find/replace for the body. The only problem with it is that it completely strips out any and all formatting, including tables, colors, etc.
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
(You may also notice I added a -8 to the date format. I figured that if I can't get it to always add the exact date I'm looking for, I can at least get it close.)
回答1:
Here is a quick and simple way to replace the text in email. I think the only issue may be with calculating the date for the monday. I will update that in a minute
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
I took the below method, as it calulates the future Monday and used it, it was code I already had. and it is used such as Format(Now + DaysUntilMonday - 7, "MMMM dd, yyyy") so get the upcoming Monday and then subtract 7 giving you the previous Monday. The code can be revamped to calculate the previous monday in one shot though
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
回答2:
Due to being mobile I cant post ready code at the moment but I am sure you can solve this yourself with two hints: For the formatting problem use .htmlbody instead of body For Monday last week use datediff; starting today minus 7 days plus the werkday-number of today.
I hope this helps, Max
回答3:
I haven't found the perfect answer, but I have figured out a very workable solution, so I figured I would share it in case anyone has the same issue in the future.
First of all, @Sorceri asked to see the code I used to generate the email, so here it is:
Sub ReportProduction()
Dim myTemplate As Outlook.MailItem
Set myTemplate = Application.CreateItemFromTemplate(Environ("Appdata") & _
"\Microsoft\Templates\ReportProduction.oft")
myTemplate.Display
End Sub
Like I said before, it simply launches an email template that I created in advance.
Now I use the following code to do a find/replace in the body (which I just found and tweaked to suit my needs):
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
I feel like some of this might be overkill, but it runs perfectly. Because this only does a find/replace on the body, I added the following afterwards to take care of the subject line.
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
It's not perfect and I'm sure it could be optimized somehow so that the first find/replace handles both the body and the subject line, but I'm really happy with the results.
I just wish I knew more about date formatting so that I could make it enter the Monday of the prior week instead of just counting back eight days.
回答4:
I finally figured out how insert the exact date I need and I've got it simplified down to one easy macro that opens the template and changes the dates in the body and subject line to the date from the prior week's Monday. Since this solution does everything I was originally looking to accomplish, I figured I should create a new answer. I'm apprehensive about deleting or editing the previous answer because someone might still find its information useful. Without further ado, here is the code I'm now using:
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
I also needed to add the following function:
Function GetWeekStartDate(ByVal strDate, _
Optional ByVal lngStartDay As Long = 2) As String
GetWeekStartDate = DateAdd("d", -Weekday(CDate(strDate), _
lngStartDay) + 1, CDate(strDate))
End Function
来源：https://stackoverflow.com/questions/19711400/how-do-i-set-up-an-email-template-with-dynamic-dates-or-alternatively-create-a