Resend Multiple Emails via Outlook VBA from Folder / Outbox Stuck problems when sending multiple emails Macro

When emails stuck on outbox;
Copy/ Move them to another folder;
Clear outbox
Use the macro to send the remaining emails ;

In the first place, press “Alt + F11” key buttons in the main Outlook window.
After getting into the “Microsoft Visual Basic for Applications” window, open a blank module.
Subsequently, copy the following VBA code into such a module. ( MACRO CODE.TXT)

After that, you can exit the current window.
Later add this macro to Quick Access Toolbar.
Finally, you can take a shot.
Firstly, select the source emails.
Then press the macro button in Quick Access Toolbar.
Immediately, all the emails will be resent to its original recipients as usual.

Macro Code:


Sub BatchResendEmails()
Dim objSelection As Outlook.Selection
Dim objMail As Outlook.MailItem
Dim objInspector As Outlook.Inspector
Dim objResendMail As Outlook.MailItem
Set objSelection = Application.ActiveExplorer.Selection
If Not (objSelection Is Nothing)
Then
On Error Resume Next
For Each objMail In objSelection
objMail.Display
Set objInspector = my
Item.GetInspector
'Resend message
objInspector.CommandBars.ExecuteMso ("ResendThisMessage")
Set objResendMail = Application.ActiveInspector.CurrentItem
'You can change the email details as per y
our needs
With objResendMail
.Subject = "Resent: " & objMail.Subject
.Send
End With
objMail.Close olDiscard
Next
End If
End Sub