Excel 2010 VBA Outlook Email Sender Follow-up Tag

Question

I have created the below code which emails a workbook automatically and I would like to flag the sent email with a sender follow-up 2 days from the sent date to remind me to follow up the sent email in 2 days.

I have looked at other forums without success and the code that I have found only sets the flag for the recipient.

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim wb As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim ShtName As String
Dim ws As Worksheet

ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & "File Name " & Format(Now, "dd-mm-yy") & ".xlsm"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)


strbody = " Please see the attached spreadsheet.

" & _"Please don't hesitate to contact me if you have any questions.
"


'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Expediting Officer.htm"


If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If


On Error Resume Next


With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = strbody & "
" & Signature
.display
.Attachments.Add ("File location"\"File Name " & Format(Now, "dd-mm-yy") & ".xlsm")
.display
.Importance = 2
End With

Answer 1

The MailItem class provides the following properties to get the job done:

• MarkAsTask - marks a MailItem object as a task and assigns a task interval for the object.
• TaskDueDate - sets a Date value that represents the due date of the task for this MailItem.
• ReminderSet - sets a Boolean value that is True if a reminder has been set for this item.
• ReminderTime - sets a Date indicating the date and time at which the reminder should occur for the specified item.

See the sample code:

 Public Sub FlagMessage(Item As Outlook.MailItem)
  With Item
    .MarkAsTask olMarkThisWeek
    ' sets a due date in 48 hours
    .TaskDueDate = Now + 2
    .ReminderSet = True
    .ReminderTime = Now + 2
    .Save
  End With
End Sub