Sub RedirectEmail()
'works in Outlook 2013/2016
  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")
    
    

Set olResendMsg = Application.ActiveInspector.currentItem

' update fields if needed
olResendMsg.Subject = myItem.Subject & " (resend)"
'olResendMsg.Send

  ' close orig email
  myItem.Close olDiscard

exitproc:
Set myItem = Nothing
Set objInsp = Nothing
Set objActionsMenu = Nothing
Set olResendMsg = Nothing
End Sub