Recipients(1) generates Error 440 array index out of bounds

Question

I have Outlook VBA code that looks for a condition to match the exact subject and exact email address in one mailbox and then send a reply (Template) to the recipient of that email.

The script was working but lately is getting

Error 440 for array out of bounds.

When I debug it highlights the line:

Set pa = recips(1).PropertyAccessor"

The code is below.

Option Explicit

Private objNS As Outlook.NameSpace
Private WithEvents objNewMailItems As Outlook.Items

'Update the AWS and Azure auto reply template path
Private Const AWS_AUTO_REPLY = "C:\Users\Documents\AWS_New_Account.oft"
Private Const AZURE_AUTO_REPLY = "C:\Users\Documents\Azure_New_Account.oft"


Private Sub Application_Startup()

Dim objMyInbox As Outlook.MAPIFolder
Dim oAccount As Account
Dim Store As Outlook.Store

'Set objNS = Application.GetNamespace("MAPI")

'For Each oAccount In Session.Accounts
'    Set Store = oAccount.DeliveryStore
'    Set objMyInbox = Store.GetDefaultFolder(olFolderInbox)
'    Set objNewMailItems = objMyInbox.Items
'    Set objMyInbox = Nothing
'   MsgBox "Application_Startup"
'Next

Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.Folders("[email protected]").Folders("Inbox")
Set objNewMailItems = objMyInbox.Items

Set objMyInbox = Nothing
MsgBox "Script Starting"
  
End Sub


Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)

Dim subjectString As String
Dim senderEmailString As String
Dim recipientEmailString As String
Dim oRespond As Outlook.MailItem

Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = Item.Recipients
'MsgBox "objNewMailItems_ItemAdd function call"
'Ensure we are only working with e-mail itemshe
If Item.Class <> olMail Then Exit Sub
        
subjectString = "" + Item.Subject
senderEmailString = "" + Item.SenderEmailAddress
    
'GetSMTPAddressForRecipients (Item)
recipientEmailString = ""
Set recips = Item.Recipients
'For Each recip In recips
    Set pa = recips(1).PropertyAccessor
    recipientEmailString = pa.GetProperty(PR_SMTP_ADDRESS) & ";" & recipientEmailString
           
'Next
        
If (InStr(recipientEmailString, "naws") > 0) Or (InStr(recipientEmailString, "xaws") > 0) Or (InStr(recipientEmailString, "saws") > 0) Or (InStr(recipientEmailString, "vcaws") > 0) Or (InStr(recipientEmailString, "daws") > 0) Or (InStr(recipientEmailString, "vaws") > 0) Or (InStr(recipientEmailString, "rovisioningteam") > 0) Then
    'MsgBox "D ACCOUNT - DO NOT SEND"
    GoTo ENDOFCODE
End If

If InStr(subjectString, "Welcome to your Azure free account") > 0 Then
    If InStr(senderEmailString, "[email protected]") > 0 Then
                
        ' This sends a response back using a template
                               
        ' Enter the actual path for
        Set oRespond = Application.CreateItemFromTemplate(AZURE_AUTO_REPLY)
                
        With oRespond
            '.Recipients.Add Item.To
                    
            .Recipients.Add pa.GetProperty(PR_SMTP_ADDRESS)
            .Recipients.Add("[email protected]").Type = (olCC)
                    
            ' includes the original message as an attachment
            .Attachments.Add Item

            ' use this for testing, change to .send once you have it working as desired
            '.Display
            '.Send
        End With
    End If
End If
    
If InStr(subjectString, "[EXT] Welcome to Amazon Web Services") > 0 Then
    If InStr(senderEmailString, "[email protected]") > 0 Then
         
        ' This sends a response back using a template
        'MsgBox "AWS CONDITION"
                               
        Set oRespond = Application.CreateItemFromTemplate(AWS_AUTO_REPLY)
                
        With oRespond
            '.Recipients.Add Item.To
                    
            .Recipients.Add pa.GetProperty(PR_SMTP_ADDRESS)
            .Recipients.Add("[email protected]").Type = (olCC)
                                      
            ' includes the original message as an attachment
            .Attachments.Add Item
                    
            'MsgBox "AWS CONDITION 2"

            ' use this for testing, change to .send once you have it working as desired
            .Display
            .Send
        End With
    End If
End If

ENDOFCODE:
    Set oRespond = Nothing

End Sub


Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = mail.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        Debug.Print recip.Name & " SMTP=" _
           & pa.GetProperty(PR_SMTP_ADDRESS)
    Next
End Sub


Function ResolveDisplayNameToSMTP(sFromName) As String
    
    Dim OLApp As Object 'Outlook.Application
    Dim oRecip As Object 'Outlook.Recipient
    Dim oEU As Object 'Outlook.ExchangeUser
    Dim oEDL As Object 'Outlook.ExchangeDistributionList

    Set OLApp = CreateObject("Outlook.Application")
    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        Select Case oRecip.AddressEntry.AddressEntryUserType
            Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
                Set oEU = oRecip.AddressEntry.GetExchangeUser
                If Not (oEU Is Nothing) Then
                    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
                End If
            Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
            ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
        End Select
    End If
End Function


Sub Project1()

End Sub

Answer 1

You run into a message with no recipients, hence the line accessing the very first recipient fails.

   recipientEmailString = ""
   For Each recip In recips
        Set pa = recip.PropertyAccessor
        recipientEmailString = pa.GetProperty(PR_SMTP_ADDRESS) & ";" & recipientEmailString
    Next