I have a function that allows to send emails. Is it possible to add a flag with a reminder for the sender? [edit] I don't need the window itself, I just want to set a reminder for the sender.
Function SendHTMLEmail()
Dim olApp As Object
Dim NewMail As Object
On Error GoTo err
Set olApp = CreateObject("Outlook.Application")
Set NewMail = olApp.CreateItem(0)
With NewMail
.subject = "subject"
.body = "body"
.Display
bodyFormat = "<BODY style=font-family:Calibri>" & body & "</BODY>"
NewMail.HTMLBody = bodyFormat & NewMail.HTMLBody
End With
err:
Set olApp = Nothing
Set NewMail = Nothing
End Function
If there is no way without user interaction, there is a generic command to press a button that still works for this button.
Function SendHTMLEmail()
Dim olApp As Object
Dim NewMail As Object
On Error GoTo err
Set olApp = CreateObject("Outlook.Application")
Set NewMail = olApp.CreateItem(0)
With NewMail
.Subject = "subject"
.Body = "body"
.Display
' If the AddReminder button is available in your version of Outlook.
.GetInspector.CommandBars.ExecuteMso ("AddReminder")
' Some previously working code, where the applicable button is available, now fails.
'
' https://docs.microsoft.com/en-us/office/vba/api/Office.CommandBars.ExecuteMso
'
' This method is useful in cases where there is no object model for a particular command.
' Works on controls that are built-in buttons, toggleButtons, and splitButtons.
' On failure it returns E_InvalidArg for an invalid idMso,
' and E_Fail for controls that are not enabled or not visible.
End With
err:
Set olApp = Nothing
Set NewMail = Nothing
End Function
You cannot review before sending but to get the same result after sending with the ItemAdd event on the Sent Items folder:
In the ThisOutlookSession module
Private Sub sentFolderItems_ItemAdd(ByVal obj As Object)
Dim mail As MailItem
If TypeOf obj Is MailItem Then
Set mail = obj
With mail
Debug.Print
Debug.Print ".Subject.......: " & .Subject
' restrict mail in an appropriate manner if needed
'If InStr(UCase(.Subject), UCase("add follow up flag and reminder")) > 0 Then
' this sets the "Follow up" flag
'
' *** Add Reminder option not required ***
'
' https://docs.microsoft.com/en-ca/office/vba/api/Outlook.OlMarkInterval
.MarkAsTask olMarkNoDate
Debug.Print ".IsMarkedAsTask: " & .IsMarkedAsTask
' if Add Reminder is available
'.TaskStartDate = Date + 1
'Debug.Print ".TaskStartDate.: " & .TaskStartDate
' if Add Reminder is available
'.TaskDueDate = Date + 2
'Debug.Print ".TaskDueDate...: " & .TaskDueDate
.ReminderSet = True
' in a MarkAsTask item, if Add Reminder is available
' ReminderTime is displayed
'
' in a .FlagRequest = "test" item
' or deprecated .FlagStatus = olFlagMarked item,
' use .FlagDueBy
'
' d = days, h=hour, n = minute not m
.ReminderTime = DateAdd("n", 1, Now)
.Save
' ** A saved ReminderTime is not sufficient to trigger a reminder
' ** must have the Add Reminder option in the menu
Debug.Print ".ReminderTime..: " & .ReminderTime
'End If
End With
End If
End Sub
To test
Private Sub sentFolderItems_ItemAdd_test()
sentFolderItems_ItemAdd ActiveInspector.CurrentItem
End Sub
To set up sentFolderItems_ItemAdd
.
Option Explicit
Private WithEvents sentFolderItems As Items
Sub Application_Startup()
Dim sentFolder As folder
Set sentFolder = Session.GetDefaultFolder(olFolderSentMail)
Set sentFolderItems = sentFolder.Items
End Sub
Run Application_Startup
manually or restart Outlook.
Note: rerun Application_Startup
if/when the event mysteriously stops triggering.
Without Private
you can assign to a button or call from other code to reduce the downtime.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.