макрос для загрузки выбранных сообщений вложения - проблема с количеством загруженных файлов

Question

Я изменил некоторые коды для получения выбранных вложений сообщений на моем жестком диске, как показано ниже:

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

электронная почта моей цели использует службу imap ...

этот код VB работает отлично!

но моя проблема в том, что когда загрузка закончена, у нас нет всех необходимых файлов в папке вложений! (только некоторые из них там)
У меня в почтовом ящике 450 UNREAD писем о том, что все они имеют прикрепленные файлы ...
но у нас есть только 200 файлов в папке вложений! (создается верхними кодами)
как я могу исправить эту проблему?
кажется, что эта проблема связана с непрочитанными сообщениями и моей скоростью ADSL (но это не должно быть, я не знаю?!)
когда вы читаете письмо, кажется, что Outlook делает что-то с этим письмом, и в следующий раз, когда электронное письмо работает быстрее из-за его кэширования. как я могу сделать эту работу для моих непрочитанных писем с верхними кодами?
или есть какие-то идеи по поводу этой проблемы?

наконец я был бы очень признателен для просмотра и добавления или исправления моих кодов

ВЫПУСК После комментариев:

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

но предыдущая проблема все еще существует
все мои электронные письма во входящей почте (ВЫБРАННАЯ ПАПКА ДЛЯ ВЕРХНЕГО КОДА) имеют 455 (5 прочитанных + 450 непрочитанных) MsgBox "ItemsCount:" & ItemsCount возвращает -> 455 MsgBox "Sum of All ItemAttCount:" & ItemsAttachmentsCount возвращает 200 или чуть больше

есть идеи?

Answer 1

Возможная проблема в том, что не все ваши сообщения выделены в проводнике.Ваш код требует, чтобы сообщения выбирались в текущем окне проводника Outlook.

Попробуйте напечатать количество выбранных электронных писем:

Set objSelection = Application.ActiveExplorer.Selection
Debug.Print objSelection.Count

Если результат (видимый в окне отладки) не 450, то не все ваши 450 сообщений выбраны, и этопочему некоторые из них игнорируются.

РЕДАКТИРОВАТЬ : Согласно вашему обновленному вопросу, код правильно находит все сообщения электронной почты, но только некоторые из вложений.Это требует некоторой доброй старомодной отладки, помимо того, что можно ответить на этом сайте.

Попробуйте Debug.Print Item.Attachments.Count в начале цикла For Each Item....Иногда количество вложений равно нулю?Для каких сообщений он равен нулю?

РЕДАКТИРОВАТЬ 2 : вы предполагаете, что существует какое-то кэширование вложений для открытых писем.Чтобы проверить это (и решить проблему, если это действительно проблема), вы можете открыть почтовые элементы перед сохранением вложений (а затем закрыть почтовый элемент, когда закончите).Это можно сделать так:

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