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

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 protected]"

 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