用于下载选定邮件附件的宏 - 有关下载文件计数的问题

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 封未读封电子邮件，所有邮件都有附件...
但我们的附件文件夹中只有 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 "所有 ItemAttCount 的总和：" & ItemsAttachmentsCount 返回 200 或更多一点

知道吗？

Answer 1

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

尝试打印所选电子邮件的计数：

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

如果结果（在调试窗口中可见）不是 450，则并非所有 450 封邮件都被选中，这就是其中一些邮件被忽略的原因。

编辑：根据您更新的问题，代码正确找到所有电子邮件，但仅找到一些附件。这需要一些好的老式调试，超出了本网站所能回答的范围。

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

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