Forward All Messages

 

A reader going by the name birdmanjrmd asked me to create a solution that forwards all the messages in a folder to another person. birdmanjrmd asks that the solution

• Prompt him for text to send with each message. The script will include the text he enters in the body of each item it forwards.
• Prompt him for a folder to move processed items to. The script will move each item it processes to this folder.

birdman didn’t specify how the script should get the address of the person to forward the messages to. I decided to handle that by prompting for the address. Here then is the logic the script uses

1. Prompt for the address of the person to forward the messages to. If the user doesn’t enter an address, then stop processing.
2. Prompt for the text to include in the body of each forwarded item. If the user doesn’t enter any text, then stop processing.
3. Prompt for the folder to move processed items to. If the user doesn’t select a folder, then stop processing.
4. Process all the items in the currently selected folder. For each item, create an email, attach the current item to it, address the message to the address the user entered in step #1, set the message’s body to the text entered in step #2, send the message, then move the item to the folder selected in step #3.

Instructions.

Follow these instructions to add the code to Outlook.

1. Start Outlook
2. Press ALT + F11 to open the Visual Basic Editor
3. If not already expanded, expand Microsoft Office Outlook Objects
4. If not already expanded, expand Modules
5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert → Module.
6. Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
7. Click the diskette icon on the toolbar to save the changes
8. Close the VB Editor

Sub ForwardAll()
    Const SCRIPT_NAME = "Forward All"
    Dim olkFld As Outlook.MAPIFolder, _
        olkItm As Object, _
        olkFwd As Outlook.MailItem, _
        strAdr As String, _
        strMsg As String, _
        intIdx As Integer, _
        intCnt As Integer
    strAdr = InputBox("Please enter the address of the person you want to forward the messages to.", SCRIPT_NAME)
    If strAdr = "" Then
        MsgBox "You failed to enter an address to forward the messages to.  Operation cancelled.", vbCritical + vbOKOnly, SCRIPT_NAME
    Else
        strMsg = InputBox("Please enter the text you want to send with each forwarded message.", SCRIPT_NAME)
        If strMsg = "" Then
            MsgBox "You failed to enter text you want to send with the forwarded messages.  Operation cancelled.", vbCritical + vbOKOnly, SCRIPT_NAME
        Else
            Set olkFld = Session.PickFolder
            If TypeName(olkFld) = "Nothing" Then
                MsgBox "You did not select a folder to move the processed messages to.  Operation cancelled.", vbCritical + vbOKOnly, SCRIPT_NAME
            Else
                If Application.ActiveExplorer.CurrentFolder.Items.Count > 0 Then
                    For intIdx = Application.ActiveExplorer.CurrentFolder.Items.Count To 1 Step -1
                        Set olkItm = Application.ActiveExplorer.CurrentFolder.Items.Item(intIdx)
                        Set olkFwd = Application.CreateItem(reolMailItem)
                        With olkFwd
                            .To = strAdr
                            .Subject = "FW: " & olkItm.Subject
                            .Attachments.Add olkItm
                            .Body = strMsg
                            .Send
                            olkItm.Move olkFld
                        End With
                        intCnt = intCnt + 1
                    Next
                    MsgBox "I forwarded " & intCnt & " messages to " & strAdr & ".", vbInformation + vbOKOnly, SCRIPT_NAME
                Else
                    MsgBox "The selected folder is empty.  Operation cancelled.", vbInformation + vbOKOnly, SCRIPT_NAME
                End If
            End If
        End If
    End If
    Set olkFld = Nothing
    Set olkItm = Nothing
    Set olkFwd = Nothing
End Sub

Revisions.

Revision 1.

This revision is for a reader named Cooldudejx. Cooldudejx asked for a version that meets the following requirements

1. All messages should get forwarded in the usual method where the entire previous mail chain is visible [it should be as good as selecting an email and clicking on the forward button].The forward email as attachment does not work well in my environment.
2. Attachments in the email should be forwarded as well.
3. The subject line for all the messages being forwarded should be replaced with a pre defined text string. This txt string should be hard-coded in the VBA script & not as a user Input popup
4. The body of the forwarded email can be empty. Do not stop processing
5. Instead of moving the processed items to another folder; let all processed emails be flagged as complete.
6. The macro should start processing from the current email selected and continue downwards till the last email in the folder. [So if for any reason the macro stops processing…then we will know exactly where to continue processing from]

As I explained to Cooldudejx, I can handle everything except requirement #6. I’m not aware of any way to determine which item is the next item in a folder. Outlook doesn’t order items in the same way you see them in the GUI. Since Cooldudejx wants the script to mark processed items complete, I decided that the best way to handle #6 was to have the code ignore items marked complete.

Cooldudejx will follow the instructions from the original post to add the code to Outlook.

Sub ForwardAll()
    Const SCRIPT_NAME = "Forward All"
    'On the next line edit the subject as desired.  The script will use this subject on all forwarded messages.
    Const NEW_SUBJECT = "TechnicLee AutoForward"
    Dim olkFld As Outlook.MAPIFolder, _
        olkHit As Outlook.Items, _
        olkItm As Object, _
        olkFwd As Object, _
        strAdr As String, _
        strMsg As String, _
        intIdx As Integer, _
        intCnt As Integer
    strAdr = InputBox("Please enter the address of the person you want to forward the messages to.", SCRIPT_NAME)
    If strAdr = "" Then
        MsgBox "You failed to enter an address to forward the messages to.  Operation cancelled.", vbCritical + vbOKOnly, SCRIPT_NAME
    Else
        Set olkFld = Session.PickFolder
        If TypeName(olkFld) = "Nothing" Then
            MsgBox "You did not select a folder to move the processed messages to.  Operation cancelled.", vbCritical + vbOKOnly, SCRIPT_NAME
        Else
            Set olkHit = olkFld.Items.Restrict("[FlagStatus] <> 1")
            If olkHit.Count > 0 Then
                For intIdx = olkHit.Count To 1 Step -1
                    Set olkItm = olkHit(intIdx)
                    If olkItm.Class = olMail Then
                        Set olkFwd = olkItm.Forward
                        With olkFwd
                            .To = strAdr
                            .Subject = NEW_SUBJECT
                            .Send
                        End With
                        With olkItm
                            .FlagStatus = olFlagComplete
                            .Save
                        End With
                        intCnt = intCnt + 1
                    End If
                Next
                MsgBox "I forwarded " & intCnt & " messages to " & strAdr & ".", vbInformation + vbOKOnly, SCRIPT_NAME
            Else
                MsgBox "The selected folder is empty.  Operation cancelled.", vbInformation + vbOKOnly, SCRIPT_NAME
            End If
        End If
    End If
    Set olkFld = Nothing
    Set olkItm = Nothing
    Set olkFwd = Nothing
End Sub