![]() |
macro can not get all attachments in one time
I wrote the following macro in outlook to get attachments from
incoming mails. Once the attachments are downloaded and sent to a specified folder the mail (together with its attachment) will be move d to \done folder. The macro works, but it does not work as I expected. My incoming mails are divided into days like Today, Yesterday, etc. When I click Run (the macro) it will process all incoming mails in Todays group. I have to click Run again, then it moves all mails in Yesterdays group BUT left the last one. So I have to click the run button for the third time to process the last one mail. The counter intNumberOfMail (see below in macro) is correct. It shows number of all incoming mails. The question is that the loop For Each Item in MailOrderFiles does not exhaust all mails in mail box. I would be very grateful if someone can show me why it does not move all mails in the mail box? Thank you for your help. Here is the macro: ' Check the order mail box for attached files and saves them to I: \imports\upload. Sub GetMailAttachments() Dim App As Outlook.Application Dim ns As NameSpace Dim Item As Object Dim Attch As Attachment Dim ii As Integer Dim jj As Integer Dim MailOrderFiles As Items Dim DoneFolder As Outlook.MAPIFolder Dim intNumberOfMail As Integer Const FILE_PATH As String = "I:\Imports\uploads\" ' On Error GoTo GetAttachments_err Set App = CreateObject("Outlook.Application") Set ns = App.GetNamespace("MAPI") Set MailOrderFiles = ns.Folders.Item("Mailbox - Orders").Folders.Item("Inbox").Items Set DoneFolder = ns.Folders.Item("Mailbox - Orders").Folders.Item("Done") intNumberOfMail = MailOrderFiles.Count If intNumberOfMail 0 Then For Each Item In MailOrderFiles For jj = 1 To Item.Attachments.Count Set Attch = Item.Attachments(jj) Attch.SaveAsFile FILE_PATH & Attch.FileName Item.Move DoneFolder intNumberOfMail = intNumberOfMail - 1 Next Next Item End If GetAttachments_exit: Set Atmt = Nothing Set Item = Nothing Set ns = Nothing Exit Sub GetAttachments_err: MsgBox "Error has occurred." _ & vbCrLf & "Error Description: " & Err.Description GoTo GetAttachments_exit End Sub |
macro can not get all attachments in one time
This is one of the situations where you have to do a reverse loop, because
the number of message items in the collection change as you move them. So try this kind of loop: For intX = MailOrderFiles.Count To 1 Step -1 Set myItem = MailOrderFiles.Item(intx) .... myItem.Move .... Next -- Eric Legault - Outlook MVP, MCDBA, MCTS (SharePoint programming, etc.) Try Picture Attachments Wizard for Outlook: http://www.collaborativeinnovations.ca Blog: http://blogs.officezealot.com/legault/ " wrote: I wrote the following macro in outlook to get attachments from incoming mails. Once the attachments are downloaded and sent to a specified folder the mail (together with its attachment) will be move d to \done folder. The macro works, but it does not work as I expected. My incoming mails are divided into days like Today, Yesterday, etc. When I click Run (the macro) it will process all incoming mails in Todayβs group. I have to click Run again, then it moves all mails in Yesterdayβs group BUT left the last one. So I have to click the run button for the third time to process the last one mail. The counter intNumberOfMail (see below in macro) is correct. It shows number of all incoming mails. The question is that the loop βFor Each Item in MailOrderFilesβ does not exhaust all mails in mail box. I would be very grateful if someone can show me why it does not move all mails in the mail box? Thank you for your help. Here is the macro: βββββββββββββββββ βββββββββββββββββ ββββββββββββββββ βββββββββββββββββ βββββββββββββββββ ββββββ ' Check the order mail box for attached files and saves them to I: \imports\upload. Sub GetMailAttachments() Dim App As Outlook.Application Dim ns As NameSpace Dim Item As Object Dim Attch As Attachment Dim ii As Integer Dim jj As Integer Dim MailOrderFiles As Items Dim DoneFolder As Outlook.MAPIFolder Dim intNumberOfMail As Integer Const FILE_PATH As String = "I:\Imports\uploads\" ' On Error GoTo GetAttachments_err Set App = CreateObject("Outlook.Application") Set ns = App.GetNamespace("MAPI") Set MailOrderFiles = ns.Folders.Item("Mailbox - Orders").Folders.Item("Inbox").Items Set DoneFolder = ns.Folders.Item("Mailbox - Orders").Folders.Item("Done") intNumberOfMail = MailOrderFiles.Count If intNumberOfMail 0 Then For Each Item In MailOrderFiles For jj = 1 To Item.Attachments.Count Set Attch = Item.Attachments(jj) Attch.SaveAsFile FILE_PATH & Attch.FileName Item.Move DoneFolder intNumberOfMail = intNumberOfMail - 1 Next Next Item End If GetAttachments_exit: Set Atmt = Nothing Set Item = Nothing Set ns = Nothing Exit Sub GetAttachments_err: MsgBox "Error has occurred." _ & vbCrLf & "Error Description: " & Err.Description GoTo GetAttachments_exit End Sub βββββββββββββββββ βββββββββββββββββ ββββββββββββββββ βββββββββββββββββ βββββββββββ |
macro can not get all attachments in one time
Eirc:
Thank you so much. It works! Your reply helps me not only in solving the issue but also let me know why it does not work the way I expected. Franco On Apr 24, 11:11*am, Eric Legault [MVP - Outlook] wrote: This is one of the situations where you have to do a reverse loop, because the number of message items in the collection change as you move them. *So try this kind of loop: For intX = MailOrderFiles.Count To 1 Step -1 * * *Set myItem = MailOrderFiles.Item(intx) * * *.... * * *myItem.Move ... Next -- Eric Legault - Outlook MVP, MCDBA, MCTS (SharePoint programming, etc.) Try Picture Attachments Wizard for Outlook:http://www.collaborativeinnovations.ca Blog:http://blogs.officezealot.com/legault/ |
All times are GMT +1. The time now is 03:37 PM. |
Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2006 OutlookBanter.com