How to send mail based on a draft then keep the draft? - vba

Question

We are updating mails from the drafts folder and sending them a few times a day.
I want to open a selected mail resend it save it so it goes back to drafts and then close it.
I tried below
Sub DRAFT()
Dim myItem As Outlook.MailItem
Dim objInsp As Outlook.Inspector
Dim objActionsMenu As Office.CommandBarControl
Dim olResendMsg As Outlook.MailItem
' get current item & open if needed
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set myItem = Application.ActiveExplorer.Selection.Item(1)
myItem.Display
Case "Inspector"
Set myItem = Application.ActiveInspector.CurrentItem
Case Else
End Select
On Error GoTo 0
If myItem Is Nothing Then
MsgBox "Could not use current item. Please select or open a single email.", _
vbInformation
GoTo exitproc
End If
' run the resend command
Set objInsp = myItem.GetInspector
objInsp.CommandBars.ExecuteMso ("ResendThisMessage")
' save orig email
myItem.Save
' close orig email
myItem.Close
exitproc:
Set myItem = Nothing
Set objInsp = Nothing
Set objActionsMenu = Nothing
Set olResendMsg = Nothing
End Sub

Answer 1

You need to pass a OlInspectorClose enumeration value to the MailItem.Close method. It indicates the close behavior, i.e. the save mode. If the item displayed within the inspector has not been changed, this argument has no effect.
Name Value Description
olDiscard 1 Changes to the document are discarded.
olPromptForSave 2 User is prompted to save documents.
olSave 0 Documents are saved.
So, your code should like that:
' close orig email
myItem.Close olSave
Instead of executing the ribbon control programmatically using the CommandBars.ExecuteMso method you may try to create a cope of the source item and then send it.
The ExecuteMso 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.
Instead, you may use the MailItem.Copy method which creates another instance of an object.
Sub CopyItem()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Dim myItem As Outlook.MailItem
Dim myCopiedItem As Outlook.MailItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myNewFolder = myFolder.Folders.Add("Saved Mail", olFolderDrafts)
Set myItem = Application.CreateItem(olMailItem)
myItem.Subject = "Speeches"
Set myCopiedItem = myItem.Copy
myCopiedItem.To = "email#address.com"
myCopiedItem.Send()
End Sub

Answer 2

Although there is a mistake in myItem.Close, you cannot resend mail that has not been sent.
Option Explicit
Sub SendMailBasedOnPermanentDraft()
Dim myItem As MailItem
Dim objInsp As Inspector
Dim myCopyOfUnsentItemInDrafts As MailItem
' get current item & open if needed
On Error Resume Next
Select Case TypeName(ActiveWindow)
Case "Explorer"
Set myItem = ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set myItem = ActiveInspector.CurrentItem
Case Else
End Select
On Error GoTo 0
If myItem Is Nothing Then
MsgBox "Could not use current item. Please select or open a single email.", vbInformation
GoTo exitProc
End If
If myItem.Sent = False Then
Set myCopyOfUnsentItemInDrafts = myItem.copy
With myCopyOfUnsentItemInDrafts
.Subject = "Copied " & Now & ": " & myItem.Subject
.Save
.Display ' change to .Send
End With
Else
MsgBox "Select or open a single unsent email.", vbInformation
End If
exitProc:
Set myItem = Nothing
Set objInsp = Nothing
Set myCopyOfUnsentItemInDrafts = Nothing
End Sub