刪除電子郵件附件在Outlook

Question

電子郵件

我創建這個宏，讓我做到以下幾點：

1. 選擇一個文件夾，以附件保存到
2. 選擇一個日期範圍從
下載電子郵件附件

保存電子郵件後，我需要從電子郵件中刪除保存的附件，並將其替換爲保存位置的鏈接。

這裏是我使用的代碼：

Option Explicit 

Sub SaveMailAttachments() 
On Error Resume Next 
Dim ns As NameSpace 
Set ns = GetNamespace("MAPI") 
Dim Inbox As MAPIFolder 
Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
Dim saveFolder As String 
Dim subFolder As MAPIFolder 
Dim Item As Object 
Dim Attach As Attachment 
Dim FileName As String, fName As String 
Dim i As Integer 
Dim Searchdate As String 
Dim SentDate As String 
Dim sntDate As Date 

Searchdate = InputBox("Please enter a Previous date to search from") 

saveFolder = BrowseForFolder("Select the folder you will like to save the attachments to.") 
If saveFolder = vbNullString Then Exit Sub 

    i = 0 

    If Inbox.Items.Count = 0 Then 
    MsgBox "There are no messages in the inbox.", vbInformation, _ 
       "nothing Found" 
    Exit Sub 
End If 

On Error Resume Next 

For Each Item In Inbox.Items 
    sntDate = Item.SentOn 

    SentDate = Format(sntDate, "mm/dd/yyyy") 

    For Each Attach In Item.Attachments 
     If Searchdate < SentDate Then 
     FileName = saveFolder & "\" & Attach.FileName 
     Attach.SaveAsFile FileName 
     i = i + 1 
     End If 

    Next Attach 
    'End If 

Next Item 

End Sub 

Answer 1

要刪除附件，請撥打Attachment.Delete。您可能需要使用for i = Attachments.Count to 1 step -1循環而不是「for each」，因爲刪除附件會更改收集計數。您可能還想檢查附件擴展名/ etc。首先要確保你沒有刪除嵌入的HTML圖像附件。

要插入附件作爲參考，請調用Attachments.Add指定新的附件位置，但傳遞olByReference作爲第二個參數。

Answer 2

這裏有幾乎工作的代碼http://www.outlook-tips.net/code-samples/save-and-delete-attachments/

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 

' Get the path to your My Documents folder 
strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
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 

' Set the Attachment folder. 
strFolderpath = strFolderpath & "OLAttachments" 

'Use the MsgBox command to troubleshoot. Remove it from the final code. 
MsgBox strFolderpath 

' Check each selected item for attachments. If attachments exist, 
' save them to the Temp folder and strip them from the item. 
For Each objMsg In objSelection 

    ' This code only strips attachments from mail items. 
    If objMsg.class=olMail Then 
    ' Get the Attachments collection of the item. 
     Set objAttachments = objMsg.Attachments 
     lngCount = objAttachments.Count 

     'Use the MsgBox command to troubleshoot. Remove it from the final code. 
     MsgBox objAttachments.Count 

     If lngCount > 0 Then 

      ' We need to 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 

       ' Save attachment before deleting from item. 
       ' Get the file name. 
       strFile = objAttachments.Item(i).FileName 

       ' Combine with the path to the folder. 
       strFile = strFolderpath & strFile 

       ' Save the attachment as a file. 
       objAttachments.Item(i).SaveAsFile strFile 

       ' Delete the attachment. 
       objAttachments.Item(i).Delete 

       'write the save as path to a string to add to the message 
       'check for html and use html tags in link 
       If objMsg.BodyFormat <> olFormatHTML Then 
        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
       Else 
        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
        strFile & "'>" & strFile & "</a>" 
       End If 

       'Use the MsgBox command to troubleshoot. Remove it from the final code. 
        MsgBox strDeletedFiles 

      Next i 
     End If 

     ' Adds the filename string to the message body and save it 
     ' Check for HTML body 
     If objMsg.BodyFormat <> olFormatHTML Then 
      objMsg.Body = objMsg.Body & vbCrLf & _ 
       "The file(s) were saved to " & strDeletedFiles 
     Else 
      objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _ 
       "The file(s) were saved to " & strDeletedFiles & "</p>" 
     End If 

     objMsg.Save 
     'sets the attachment path to nothing before it moves on to the next message. 
     strDeletedFiles = "" 

    End If 
Next 

ExitSub: 

Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 

End Sub 

它採用「上的錯誤繼續下一步」讓過去的問題，但有關將鏈接到該消息的重要組成部分，是好的。

無論有什麼其他問題，它都需要其中兩個。

If Right(strFolderpath, 1) <> "\" Then strFolderpath = strFolderpath & "\"