Vba 在Outlook中保存电子邮件附件并将保存位置添加到电子邮件后删除它们

我创建了此宏，可以执行以下操作：

选择要保存附件的文件夹 选择要从中下载电子邮件附件的日期范围 保存电子邮件后，我需要从电子邮件中删除保存的附件，并将其替换为指向保存位置的链接

以下是我正在使用的代码：

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

---

要删除附件，请调用attachment.delete。您可能希望使用for i=Attachments.Count到1步骤-1循环，而不是for each，因为删除附件将更改集合计数。您可能还需要首先检查附件扩展名/etc，以确保没有删除嵌入的HTML图像附件

---

要插入附件作为引用，请调用Attachments.Add，指定新的附件位置，但将olByReference作为第二个参数传递。

这里几乎有可用的代码

它使用On Error Resume Next来解决问题，但向消息添加链接的重要部分很好

无论还有什么其他问题，它都需要其中两个

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

---

我尝试过这样做，但现在无法删除我的附件@Dimitry Streblechenkow发生了什么事？你有错误吗？ObjaAttachments。计数还是一样吗？或者别的什么？我上面的代码保持不变，只是在我为i=Item.Attachments.Count设置的每一步中都是一样的，在下一步的底部，i@Dimitry Streblenchenko i也不；没有收到错误它只是没有删除它您是否尝试在调试器中单步执行代码并检查Attachments.Count是否在调用Attachment.Delete后递减？我还避免使用多点表示法-在循环开始时检索附件对象，而不是通过调用objAttachments一次又一次地获取新对象。Itemii刚刚尝试了它，它只是跳过了整个循环。。。我不确定我是否在错误的地方开始了附件计数，但它似乎没有计算附件@Dmitry StreblechenkoThank@niton，但我已经尝试过这一次，我只是无法让它在选择日期范围和选择要保存到的文件夹时正常工作。Dmitry Streblechenko无法帮助您的一个原因是代码顶部的下一个错误简历。仅当您有特定目的时才使用此选项，而不是绕过所有错误。它应该很快被错误转到0。特别是在调试过程中，你需要看到错误。我现在尝试了，它给了我一个错误，但它是在一个完全不同的事情上。因为我试图编辑整个消息以添加被删除文件的名称。一旦我消除了这一点，同样的问题就会不断发生@尼顿

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