宏下載選定郵件中的附件 - 關於下載的文件的問題數

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個在我的收件箱未讀電子郵件，所有的人都依戀/ 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：「& ItemsCount返回 - > 455 MSGBOX 」總和所有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