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
1 answers
solution1
0 2021-12-29 15:42:40
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.