macro para baixar anexos de mensagens selecionadas - Problema com a contagem de arquivos baixados

Question

Alterei alguns códigos para obter anexos de mensagens selecionadas para o meu disco rígido, como abaixo:

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

o email do meu objetivo usa o serviço imap ...

este código vb funciona perfeito!

mas meu problema é quando o download é concluído, não precisamos de arquivos na pasta de anexos!
Tenho 450 e-mails UNREAD na minha caixa de entrada que todos eles têm anexos / s ...
mas temos apenas 200 arquivos na pasta de anexos! (criado por códigos superiores)
Como posso corrigir este problema?
parece que este problema está em relação com as mensagens não lidas e minha velocidade de ADSL (mas não deve, eu não sei ?!)
Quando você lê um e-mail, parece que o Outlook faz algumas coisas com esse e-mail e, da próxima vez, o e-mail é executado mais rapidamente por causa do armazenamento em cache. como posso fazer este trabalho para meus e-mails não lidos com códigos superiores?
ou há alguma idéia sobre esse problema?

at last I would be really appreciate for review and add or correct my codes

    

Answer 1

Se algum dos anexos tiver o mesmo nome, ele pode estar sendo substituído (não se lembra se .SaveAsFile irá sobrescrever ou causar um erro), então você deve verificar se o nome do arquivo existe primeiro ou adicionar outro identificador para o nome do arquivo (talvez o assunto da mensagem?).

O Outlook pode ser configurado para fazer coisas diferentes com contas de e-mail usando o IMAP, como baixar apenas os cabeçalhos e obter a mensagem inteira somente quando você abri-la ou fazer o download da mensagem inteira em primeiro lugar.

Você pode fazer algumas verificações aleatórias para verificar se existem anexos de mensagens que foram lidos e se não há anexos de mensagens não lidas? Isso confirmaria a teoria do IMAP e poderia ser corrigido no código com um método para baixar as mensagens selecionadas, caso ainda não estejam.