'How to write scripts in outlook to combines ThisOutlookSession and module

I tried to rewrite the code as below Could you please help me how to code in Case 2: SenderEmailAddress = multi address? Thanks you very much. May I also use array for the ConditionA. Please see my edit.

Dim recips As Outlook.Recipients 
Dim recip As Outlook.Recipient 
Set recips = mail.Recipients 

    'Case 1: If the mail is sent TO multi address (recips), in recips contains 1 email [email protected]'
    Select Case recips
    Case "[email protected]"
        Recipients = Array("[email protected]")
        xStr1 = "<p>A1</p>" 
        xStr2 = "<p>A2</p>"
    
    'Case 2: If the mail is sent TO multi address (recips), in recips contains 3 emails [email protected] [email protected] [email protected]'
    Case "[email protected]", "[email protected]", "[email protected]"
        Recipients = Array("[email protected]", "[email protected]", "[email protected]")
        xStr1 = "<p>B1</p>" 
        xStr2 = "<p>B2</p>"
    
    End Select

Sub AutoForwardAllSentItems(Item As Outlook.MailItem) 
Dim myFwd As Outlook.MailItem 
Set myFwd = Item.Forward 

Dim xStr1 As String
Dim xStr2 As String
Dim Recipient As String

'Case 1: If the mail is sent TO [email protected]'
If obj.SenderEmailAddress = "[email protected]" Then
    Recipient = "[email protected]"
    xStr1 = "<p>A1</p>" 
    xStr2 = "<p>A2</p>"

'Case 2: If the mail is sent TO [email protected] [email protected] [email protected]'
ElseIf obj.SenderEmailAddress = "[email protected]" "[email protected]" "[email protected]" Then
    Recipient = "[email protected]"
    Recipient = "[email protected]"
    Recipient = "[email protected]"
    xStr1 = "<p>B1</p>" 
    xStr2 = "<p>B2</p>"
Else
    MsgBox "None of the conditions was true, abort."
    Exit Sub
End If

myFwd.Recipients.Add Recipient 
myFwd.HTMLBody = xStr1 & xStr2 & Item.HTMLBody 

myFwd.Send 
Set myFwd = Nothing 

End Sub



Solution 1:[1]

Just use a normal If … ElseIf … EndIf construct or do some research on Select Case.

Sub AutoForwardAllSentItems(Item As Outlook.MailItem) 
    Dim myFwd As Outlook.MailItem 
    Set myFwd = Item.Forward 

    Dim xStr1 As String
    Dim xStr2 As String
    Dim Recipients() As Variant

    If ConditionA Then
        Recipients = Array("[email protected]")
        xStr1 = "<p>A1</p>" 
        xStr2 = "<p>A2</p>"
    ElseIf ConditionB Then
        Recipients = Array("[email protected]", "[email protected]", "[email protected]")
        xStr1 = "<p>B1</p>" 
        xStr2 = "<p>B2</p>"
    Else
        MsgBox "None of the conditions was true, abort."
        Exit Sub
    End If

    Dim Recipient As Variant
    For Each Recipient In Recipients
        myFwd.Recipients.Add Recipient 
    Next Recipient

    myFwd.HTMLBody = xStr1 & xStr2 & Item.HTMLBody 
    myFwd.Send 

    Set myFwd = Nothing 
End Sub

For checking for multiple recipients you can try something like this

Option Explicit

Sub AutoForwardAllSentItems(Item As Outlook.MailItem)
    Dim myFwd As Outlook.MailItem
    Set myFwd = Item.Forward

    Dim xStr1 As String
    Dim xStr2 As String
    Dim Recipients() As Variant

    Dim Recips As Outlook.Recipients
    Set Recips = mail.Recipients
    
    ' 2 Cases:
    ' 1. Get email from a1,a2,a3,b1
    ' 2. Get email from a1,a2,a3
    '
    ' a1,a2,a3,b1 it matches a1,b1 -> Forward to b2
    ' a1,a2,a3 it matches a1 -> Forward to b1,b2
    If AreRecipientsInList(Array("a1", "b1"), Recips) Then
        ' Case 1: a1 and b1 are in a1,a2,a3,b1 -> Forward to b2, do not check other criterias
        ' Case 2: a1 in in a1,a2,a3 but b1 is not -> do nothing, check next criteria
        Recipients = Array("b2")
        xStr1 = "<p>A1</p>"
        xStr2 = "<p>A2</p>"
    ElseIf AreRecipientsInList(Array("a1"), Recips) Then
        ' Case 1: a1 is in a1,a2,a3,b1 -> but since case 1 would alerady match above it does not check this criteria here
        ' Case 2: a1 in in a1,a2,a3 -> Forward to b1,b2
        Recipients = Array("b1", "b2")
        xStr1 = "<p>B1</p>"
        xStr2 = "<p>B2</p>"
    Else
        MsgBox "None of the conditions was true, abort."
        Exit Sub
    End If

    Dim Recipient As Variant
    For Each Recipient In Recipients
        myFwd.Recipients.Add Recipient
    Next Recipient

    myFwd.HTMLBody = xStr1 & xStr2 & Item.HTMLBody
    myFwd.Send

    Set myFwd = Nothing
End Sub


Public Function AreRecipientsInList(ByRef MatchRecips() As Variant, ByVal Recips As Outlook.Recipients) As Boolean
    Dim RetVal As Boolean
    RetVal = True
    
    Dim MatchRecip As Variant
    For Each MatchRecip In MatchRecips
        Dim ThisRecipIsFound As Boolean
        
        Dim Recip As Outlook.Recipient
        For Each Recip In Recips
            If Recip.Address = MatchRecip Then
                ThisRecipIsFound = True
                Exit For
            End If
        Next Recip
        
        If Not thiscecipisfound Then
            RetVal = False
            Exit For
        End If
    Next MatchRecip
    
    AreRecipientsInList = RetVal
End Function

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1