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.