使用超链接删除Outlook附件

我想将附件保存到文件夹中的所有电子邮件中，并将其粘贴到本地计算机或网络上的选定位置，从电子邮件中删除附件，然后保留电子邮件正文中的超链接显示文档的位置。使用超链接删除Outlook附件

我发现了这样一个宏。然而，我偶尔会得到一个错误13“类型不匹配”，当我打开调试器时，唯一突出显示的是宏下方的“Next”语句。

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

来源

2013-06-25 Devan Kelley

的MAPIFolder.Items收集可能含有比MailItem S以外的对象类型，如会议请求。

如果你改变它，你处理前要检查的项目类型：

Dim itm as Object 

For Each itm In olPurgeFolder.Items 

    If TypeOf itm Is MailItem Then 

     Set msg = itm 

     ' rest of code

来源

2013-08-20 09:02:30

使用超链接删除Outlook附件

回答

相关问题