節省作爲電子郵件發送的電子郵件的附件（即MSG）

我收到很多包含.msg附件的電子郵件。我通常必須手動打開電子郵件，然後打開.msg附件以轉到附加的.pdf文件。我經常以這種格式收到200多封電子郵件，需要一些時間才能打印所有PDF文件。我設法拼湊下面的代碼（有很多的幫助從在線論壇）節省作爲電子郵件發送的電子郵件的附件（即MSG）

Sub SaveOlAttachments() 

Dim olFolder As Outlook.MAPIFolder 
Dim msg As Outlook.MailItem 
Dim msg2 As Outlook.MailItem 
Dim att As Outlook.Attachment 
Dim strFilePath As String 
Dim strTmpMsg As String 
Dim fsSaveFolder As String 

fsSaveFolder = "C:\Users\nicholson.a.9\Desktop\Invoices to Print\" 

strFilePath = "C:\temp\" 
strTmpMsg = "KillMe.msg" 

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
Set olFolder = olFolder.Folders("MSG Attachments") 
i = 0 
If olFolder Is Nothing Then Exit Sub 
For Each msg In olFolder.Items 

    If msg.Attachments.Count > 0 Then 
    While msg.Attachments.Count > 0 
    bflag = False 
     If Right$(msg.Attachments(1).FileName, 3) = "msg" Then 
      bflag = True 
      msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg 
      Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg) 
     End If 
     If bflag Then 
     i = i + 1 
      sSavePathFS = fsSaveFolder & "\" & i & " - " & msg2.Attachments(1).FileName 
      msg2.Attachments(1).SaveAsFile sSavePathFS 
      msg2.Delete 
     Else 
      sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName 
      msg.Attachments(1).SaveAsFile sSavePathFS 
     End If 
     msg.Attachments(1).Delete 
     Wend 
     msg.Delete 
    End If 
Next 
End Sub

代碼工作，如果我收到一封電子郵件，味精附件，我複製郵件並將其粘貼到子 - 收件箱下方的文件夾（MSG附件），然後運行該腳本。我遇到的問題是，當附件具有相同的名稱，即AT0001時，腳本將僅提取一個附件並將所有其他附件保留。誰能幫忙？謝謝

來源

2013-05-17 Alan

您可能會保存所有附件，但最新的附件會勝出並覆蓋舊附件。您需要檢查文件是否已經存在，並使用唯一的文件名，或保存附件並在保存下一個附件之前對其進行處理。

來源

2013-05-17 16:32:49

節省作爲電子郵件發送的電子郵件的附件（即MSG）

回答

相關問題