Outlook VBA Code Only Autoforwarding 2 emails at a time from a folder

Question

I've got some code that checks for when a mail item is dropped into a specific folder and loops through 'x' amount of mailitems and autoforwards them to another email address. The problem I am running into is that when I drop more than 2 emails at a time it only picks up the first two emails and then doesn't recognize anything after. Does anyone know if Outlook has a restriction on sending emails within a certain timeframe? I was thinking about adding some sort of delay or timer between each email to see if that fixes it.

The code also doesn't seem to work if there are existing mailtems in the folder, it only works when the code is running and then a user goes to drop the mailitems into the folder.

Any suggestions would be appreciated.

Public WithEvents objInbox As Outlook.Folder

Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_StartUp()
Dim olNs As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set objInbox = olNs.Folders("test2@test.com").Folders("test")

Set objInboxItems = objInbox.Items

End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)

Dim objMail As Outlook.MailItem

Dim objForward As Outlook.MailItem

Dim olNs As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim olAtt As Attachment
Dim olAtts As Attachments
Dim olSentAtts As Attachments



Set olNs = Application.GetNamespace("MAPI")
'Set shrdRecip = olNs.CreateRecipient("test1@test.com")'
Set objInbox = olNs.Folders("test2@test.com").Folders("test")
Set objForward = Item.Forward
Set destFolder = olNs.Folders("test1@test.com").Folders("arch")
Set srcFolder = olNs.Folders("test2@test.com")


'MsgBox (objMail)'
'objMail.UnRead Or objMail.Sent'
For Each Item In objInbox.Items
 
    If TypeName(Item) = "MailItem" Then
    Set objForward = Item.Forward
    With objForward
    .Subject = Item.Subject
    .HTMLBody = "<HTML><BODY>This message contains an invoice from test1</BODY></HTML>" & objForward.HTMLBody
    .Recipients.Add ("test2@test.com")
    .Recipients.ResolveAll
    'printradu ()'
    .Display
  
   MsgBox (Item.Subject)
   MsgBox (TypeName(Item))
   Dim FilePath As String
   FilePath = "C:\Logs\OutlookLogs.txt"
   TextFile = FreeFile
    'End If'
    End With
    If Err Then
        'MsgBox (Item.Subject + "Failed to send due to: " + Err + "." + "Please try again.")'
        Open FilePath For Append As #1
        Write #1, (CStr(Item.Subject) + " Failed to send due to error code: " + CStr(Err.Description) + "." + "Please try again.")
        'Print #TextFile, (Item.Subject + "Failed to send due to: " + Err + "." + "Please try again.")'
        Close #1
        Item.Move (srcFolder)
    Else
        'MsgBox (Item.Subject + " has been sent successfully.")'
        Open FilePath For Append As #1
        Write #1, ("Subject: " + Item.Subject + " Sent time: " + CStr(Item.SentOn) + " Receieved at: " + CStr(Item.ReceivedTime) + " has been sent successfully.")
        'Print #TextFile, (Item.Subject + " has been sent successfully.")'
        Close #1
        Item.Move (destFolder)
        


    'Item.Move (destFolder)'
    
    End If
    End If
Next Item
'End If'
'Next'
'End Sub'
End Sub

Sub MyTEST()

 

End Sub

Eugene Astafiev · Answer 1 · 2021-12-29T15:49:08.777

Instead of using the foreach loop you need to use the for one reversed.

When you move items to a folder the original item is removed from the source folder. In that case Items.Count property is decreased, so in such cases you would need to iterate over all items in the reverse order - from Items.Count to zero.

For myIndex =Items.Count to 1 Step -1 ' Because collections start at 1 not 0

    Items.Item(myIndex).Move(destFolder)

Next

The problem I am running into is that when I drop more than 2 emails at a time it only picks up the first two emails and then doesn't recognize anything after.

The ItemAdd event is fired for every Outlook item added to the collection. The item that was added is passed as a parameter. So, you can do the required actions against this item when the event is fired and process all other handover items at startup in the loop. It makes sense to break the existing functionality and process the passed item only in the event handler and do the work at startup for other items hanging in the folder (leftover).

The ItemAdd event does not run when a large number of items are added to the folder at once (more than sixteen). This is a known issue when dealing with OOM.

Thanks Eugene. Using the for loop instead fixed my issue. – Scott Dec 29 '21 at 18:09 — Scott, Dec 29 '21 at 18:09
It make sense to mark the post as answer if it helps. – Eugene Astafiev Dec 29 '21 at 18:56 — Eugene Astafiev, Dec 29 '21 at 18:56

Outlook VBA Code Only Autoforwarding 2 emails at a time from a folder

1 Answers1