Resending Macro

[Rishek]

Fully aware that I am trying to do something a bit idiotic, but here's what I'm trying to achieve: I want a button that automatically sends the current item to preset addresses and then resends it twice to further addresses. Here's what I've got:


Sub MAILBLAST()
Call Resend
Call Resend2
Call Resend3
End Sub
Sub Resend()
Dim rMsg As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
Else
Set rMsg = oInspector.CurrentItem
rMsg.To = "myemail@email.com"
rMsg.To = "Address that can't be Bcc'd (Printer)"
rMsg.BCC = "Distribution 1"
rMsg.Send
End If
End Sub
Sub Resend2()
Dim rMsg As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
Else
Set rMsg = oInspector.CurrentItem
rMsg.To = ""myemail@email.com"
rMsg.BCC = "Distribution 2"
rMsg.Send
End If
End Sub
Sub Resend3()
Dim rMsg As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
Else
Set rMsg = oInspector.CurrentItem
rMsg.To = "myemail@email.com"
rMsg.BCC = "Distribution 3"
rMsg.Send
End If
End Sub


The obvious difficulty is that once the first Resend() runs, the message is sent and I lose the .CurrentItem. How can I circumvent this?

Many thanks to Stefano Balzarotti for the original code.

[gmayor]

It seems somewhat bizarre, however


Option Explicit

Sub MAILBLAST()
Dim rMsg As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
If oInspector Is Nothing Then
MsgBox "No active inspector"
GoTo lbl_Exit
Else
Set rMsg = oInspector.currentItem
Resend rMsg
Resend2 rMsg
Resend3 rMsg
End If
rMsg.Close olDiscard 'optional
lbl_Exit:
Exit Sub
End Sub

Sub Resend(rMsg As MailItem)
Dim olItem As MailItem
Set olItem = rMsg.Copy
olitem.To = "myemail@email.com"
'olItem.To = "Address that can't be Bcc'd (Printer)"
olItem.BCC = "Distribution 1"
olItem.Send
End Sub
Sub Resend2(rMsg As MailItem)
Dim olItem As MailItem
Set olItem = rMsg.Copy
olItem.To = ""myemail@email.com"
olItem.BCC = "Distribution 2"
olItem.Send
End Sub
Sub Resend3(rMsg As MailItem)
Dim olItem As MailItem
Set olItem = rMsg.Copy
olitem.To = "myemail@email.com"
olItem.BCC = "Distribution 3"
olItem.Send
End Sub

[Rishek]

Works like a charm. As dumb as it sounds, this integrates quite well into the work flow. Thanks.