Удалить вложения электронной почты после их сохранений и добавления места сохранения по электронной почте в 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 вместо «для каждого», так как удаление вложения изменит счетчик коллекции. Вы также можете проверить расширение вложений/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 

Он использует «On Error Resume Next», чтобы получить прошлые проблемы, но важная часть о добавлении ссылки на сообщения в порядке.

Независимо от других проблем, это потребует двух из них.

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