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

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