Удаление вложения Outlook с гиперссылкой на местоположение

Я хочу сохранить вложения во всех сообщениях электронной почты в папке в выбранном месте на локальном компьютере или в сети, удалить вложения из сообщения электронной почты, а затем оставить гиперссылку в теле сообщения электронной почты, показывающую, где документы находятся.

Я нашел такой макрос. ОДНАКО, время от времени я получаю сообщение об ошибке 13 «несоответствие типов», и когда я открываю отладчик, единственное, что выделяется, — это оператор «Далее» в самом низу макроса.

Public Sub SaveOLFolderAttachments()

' Ask the user to select an Outlook folder to process
Dim olPurgeFolder As Outlook.MAPIFolder
Set olPurgeFolder = Outlook.GetNamespace("MAPI").PickFolder
If olPurgeFolder Is Nothing Then Exit Sub

' Ask the user to select a file system folder for saving the attachments
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
Dim fsSaveFolder As Object
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
If fsSaveFolder Is Nothing Then Exit Sub
' Note:  BrowseForFolder doesn't add a trailing slash

' Iteration variables
Dim msg As Outlook.MailItem
Dim att As Outlook.Attachment
Dim sSavePathFS As String
Dim sDelAtts As String

For Each msg In olPurgeFolder.Items

sDelAtts = ""

' We check each msg for attachments as opposed to using .Restrict("[Attachment] > 0")
' on our olPurgeFolder.Items collection.  The collection returned by the Restrict method
' will be dynamically updated each time we remove an attachment.  Each update will
' reindex the collection.  As a result, it does not provide a reliable means for iteration.
' This is why the For Each loops will not work.
If msg.Attachments.Count > 0 Then

  ' This While loop is controlled via the .Delete method
  ' which will decrement msg.Attachments.Count by one each time.
  While msg.Attachments.Count > 0

    ' Save the file
    sSavePathFS = fsSaveFolder.Self.Path & "\" & msg.Attachments(1).FileName
    msg.Attachments(1).SaveAsFile sSavePathFS

    ' Build up a string to denote the file system save path(s)
    ' Format the string according to the msg.BodyFormat.
    If msg.BodyFormat <> olFormatHTML Then
        sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
    Else
        sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
    End If

    ' Delete the current attachment.  We use a "1" here instead of an "i"
    ' because the .Delete method will shrink the size of the msg.Attachments
    ' collection for us.  Use some well placed Debug.Print statements to see
    ' the behavior.
    msg.Attachments(1).Delete

  Wend

  ' Modify the body of the msg to show the file system location of
  ' the deleted attachments.
  If msg.BodyFormat <> olFormatHTML Then
    msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts
  Else
    msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts & "</p>"
  End If

  ' Save the edits to the msg.  If you forget this line, the attachments will not be deleted.
  msg.Save

End If

Next

End Sub

person Devan Kelley    schedule 25.06.2013    source источник


Ответы (1)


Коллекция MAPIFolder.Items может содержать типы объектов, отличные от MailItem, например запросы на собрания.

Если вы измените его, чтобы проверить тип элемента перед его обработкой:

Dim itm as Object

For Each itm In olPurgeFolder.Items

    If TypeOf itm Is MailItem Then

        Set msg = itm

        ' rest of code
person Nic Paul    schedule 20.08.2013