macro to download selected messages attachments - Problem about downloaded files count - vba

Question

I changed some codes for getting selected messages attachments to my hard drive like below :
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim I As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim Counter As Long
strFolderpath = "D:\attachments"
If (Dir$(strFolderpath, vbDirectory) = "") Then
MsgBox "'" & strFolderpath & "' not exist"
MkDir strFolderpath
MsgBox "'" & strFolderpath & "' we create it"
Else
MsgBox "'" & strFolderpath & "' exist"
End If
' Get the path to your My Documents folder
'strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
strFolderpath = strFolderpath & "\"
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' The attachment folder needs to exist
' You can change this to another folder name of your choice
' Set the Attachment folder.
strFolderpath = strFolderpath
' Check each selected item for attachments.
Counter = 1
For Each objMsg In objSelection
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' Use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.
For I = lngCount To 1 Step -1
' Get the file name.
strFile = objAttachments.Item(I).FileName
' Combine with the path to the Temp folder.
strFile = strFolderpath & Counter & "_" & strFile
' Save the attachment as a file.
objAttachments.Item(I).SaveAsFile strFile
Counter = Counter + 1
Next I
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
MsgBox "All Selected Attachments Have Been Downloaded ..."
End Sub
my goal email uses imap service...
this vb codes works perfect!
but my problem is when download is finished we have not All needed files in attachments folder! (just some of them are there)
I have 450 UNREAD emails in my inbox that all of them have attachmen/s...
but we only have 200 files in attachments folder! (created by upper codes)
how can I fix this issue?
it seems this problem is in relationship with Unread Messages And My ADSL speed (but it should n't , I don't know?!)
when u read an email it seems Outlook does some stuff with that email and so next time that email runs faster because of it's caching.
how can I do this job for my unread emails with upper codes?
or is there any idea about this problem?
at last I would be really appreciate
for review and add or correct my codes
EDITION After comments :
my new code is like below :
Public Sub SaveAttachments()
Dim OlApp As Outlook.Application
Dim Inbox As MAPIFolder
Dim Item As Object
Dim ItemAttachments As Outlook.Attachments
Dim ItemAttachment As Object
Dim ItemAttCount As Long
Dim strFolderpath As String
Dim strFileName As String
Dim Counter As Long
Dim ItemsCount As Long
Dim ItemsAttachmentsCount As Long
strFolderpath = "d:\attachments"
If (Dir$(strFolderpath, vbDirectory) = "") Then
MsgBox "'" & strFolderpath & "' not exist"
MkDir strFolderpath
MsgBox "'" & strFolderpath & "' we create it"
Else
MsgBox "'" & strFolderpath & "' exist"
End If
' Get the path to your My Documents folder
'strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
strFolderpath = strFolderpath & "\"
'On Error Resume Next
' Instantiate an Outlook Application object.
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.ActiveExplorer.CurrentFolder
Counter = 1
ItemsCount = 0
ItemsAttachmentsCount = 0
For Each Item In Inbox.Items
ItemsCount = ItemsCount + 1
For Each ItemAttachment In Item.Attachments
ItemsAttachmentsCount = ItemsAttachmentsCount + 1
' Get the file name.
strFileName = ItemAttachment.FileName
' Combine with the path to the Attachments folder.
strFileName = strFolderpath & Counter & "_" & strFileName
' Save the attachment as a file.
ItemAttachment.SaveAsFile strFileName
Counter = Counter + 1
Next ItemAttachment
Next Item
ExitSub:
Set ItemAttachment = Nothing
Set ItemAttachments = Nothing
Set Item = Nothing
Set Inbox = Nothing
Set OlApp = Nothing
MsgBox "All Selected Folder Attachments Have Been Downloaded ..."
MsgBox "ItemsCount : " & ItemsCount
MsgBox "ItemsAttachmentsCount : " & ItemsAttachmentsCount
End Sub
but the previous problem is still there
all of my emails in inbox(SELECTED FOLDER FOR UPPER CODE) are 455 (5 Read + 450 Unread)
MsgBox "ItemsCount : " & ItemsCount returns -> 455
MsgBox "Sum Of All ItemAttCount : " & ItemsAttachmentsCount returns 200 or a bit more
any idea?

Answer 1

A possible problem is that not all your messages are selected in the explorer. Your code requires the messages to be selected in the current Outlook explorer window.
Try printing the count of selected e-mails:
Set objSelection = Application.ActiveExplorer.Selection
Debug.Print objSelection.Count
If the result (visible in the debug window) is not 450, then not all your 450 messages are selected, and that's why some of them are ignored.
EDIT: According to your updated question, the code correctly finds all the e-mail messages, but only some of the attachments. This calls for some good old-fashioned debugging, beyond what can be answered on this website.
Try Debug.Print Item.Attachments.Count at the beginning of the For Each Item... loop. Is the attachment count sometimes zero? For which messages is it zero?
EDIT 2: You speculate that there is some kind of caching of attachment for opened mails. To test this (and to solve the problem if this is indeed the issue), you could open the mail items before saving the attachments (and then close the mail item when done). This can be done like this:
For Each Item In Inbox.Items
' Open the mail item
Item.Display
' Your code to save the attachments goes here.
' Close the mail item
Item.Close olDiscard
Next Item