Move e-mail to different folder

[Steph]

Hi all,

I have some code below that copies the excel attachment from every e-mail in
an Outlook folder and saves it to a specified network drive. That part has
been working great. But then I tried to move the e-mail to a different
folder after it copies the attachment. In the Outlook folder, I currently
have ben testing with 4 files.....the code moves 2 of them to the different
outlook folder, while the other 2 stay. Any idea what I'm doing wrong?
Thanks!

Sub Move()
'Saves attachments to a specified folder

Dim ol As Outlook.Application
Dim ns As Namespace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim Mi As MailItem
Dim Att As Attachment

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set Fldr = ns.Folders("Public Folders").Folders("All Public
Folders").Folders("Timesheet")
Set MoveToFldr = ns.Folders("Public Folders").Folders("All Public
Folders").Folders("Public Folders")

For Each Mi In Fldr.Items
If Mi.Attachments.Count > 0 Then
For Each Att In Mi.Attachments
iFile = iFile + 1

'Att.SaveAsFile "H:\Timesheet Data\" & Att.Filename &
CStr(iFile)
'Att.SaveAsFile "H:\Timesheet Data\ts" & CStr(iFile) & ".xls"

Att.SaveAsFile "H:\Timesheet Data\" & Format(Mi.ReceivedTime,
"yyyymmddhhmmss") & "-" & CStr(iFile) & ".xls"

Next Att
Mi.Move MoveToFldr

End If
Next Mi

Set Att = Nothing
Set Mi = Nothing
Set Fldr = Nothing
Set ns = Nothing
Set ol = Nothing
Set MoveToFldr = Nothing

End Sub

 

[Sue Mosher [MVP-Outlook]]

Never move or delete inside a For Each ... Next loop. The index is reset
each time. Instead, use a countdown loop.

Set objItems = Fldr.Items
intCount = objItems.Count
For i = intCount to 1 Step -1
Set Mi = objItems(i)
' do stuff with Mi
Next