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 电子邮件，所有这些都有附件/ s ... 但我们附件文件夹中只有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

但是之前的问题仍然存在我在收件箱中的所有电子邮件（SELECTED FOLDER FOR UPPER CODE）都是455（5阅读+ 450未读） MsgBox“ItemsCount：”＆amp; ItemsCount返回 - ＆gt; 455 MsgBox“Sum Of All ItemAttCount：”＆amp; 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

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

1 个答案: