vba 宏来下载选定的邮件附件 - 关于下载文件数的问题

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

提问by SilverLight

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...

我的目标电子邮件使用 imap 服务...

this vb codes works perfect!

这个vb代码完美无缺！

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 UNREADemails 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?

但我的问题是下载完成后，附件文件夹中没有所有需要的文件！（只有其中一些在那里）我的收件箱中
有 450封未读的电子邮件，它们都有附件...
但我们的附件文件夹中只有 200 个文件！（由上层代码创建）
我该如何解决这个问题？
看来这个问题是有未读消息和我的ADSL速度的关系（但不应该，我不知道？！）
当u阅读电子邮件似乎展望做一些事情与电子邮件等下一次电子邮件由于它的缓存运行速度更快。
我怎样才能为我的未读电子邮件完成这项工作？
或者对这个问题有什么想法吗？

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

但之前的问题仍然
是我在收件箱中的所有电子邮件（针对上部代码的选定文件夹）都是 455（5 次阅读 + 450 次未读） MsgBox "ItemsCount :" & ItemsCount 返回 -> 455 MsgBox "Sum Of All ItemAttCount : " & ItemsAttachmentsCount返回 200 或更多

any idea?

任何的想法？

回答by Jean-Fran?ois Corbett

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.

一个可能的问题是，并非所有邮件都在资源管理器中被选中。您的代码要求在当前 Outlook 资源管理器窗口中选择邮件。

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.

如果结果（在调试窗口中可见）不是 450，那么并不是所有的 450 消息都被选中，这就是其中一些被忽略的原因。

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.Countat the beginning of the For Each Item...loop. Is the attachment count sometimes zero? For which messages is it zero?

Debug.Print Item.Attachments.Count在For Each Item...循环开始时尝试。附件计数有时为零吗？对于哪些消息为零？

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:

编辑 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