macro can not get all attachments in one time

  • Thread starter Thread starter franco.boiti
  • Start date Start date
F

franco.boiti

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

‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
 
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
 
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
 
Back
Top