Outlook VBA - 分别保存附件和电子邮件答案

【问题标题】：Outlook VBA - Save Attachments and Email separatelyOutlook VBA - 分别保存附件和电子邮件
【发布时间】：2015-05-29 14:37:47
【问题描述】：

用户将选择一封电子邮件，我需要将其所有附件保存到一个文件夹+该电子邮件没有附件在一个单独的文件夹中。

我已经编写了代码，除了一个大问题之外，它似乎工作正常：

附件也会从我的收件箱中删除。删除附件后，我正在调用 SaveAs 方法，所以我认为这不应该发生。

这是我写的代码：

 Dim objMailItemOriginal As Outlook.MailItem
    Dim objMailItemNew As Outlook.MailItem
    Dim objNameSpaceUserNS As Outlook.namespace
    Dim emailPath$, tmpFolder$

    Set objMailItemOriginal = Application.ActiveExplorer.Selection(1)
    Set objMailItemNew = Application.CreateItem(olMailItem)
    Set objNameSpaceUserNS = Application.GetNamespace("MAPI")

    tmpFolder = Environ("Temp") & "\" & Format$(Now, "hh_mm_ss")
    MkDir tmpFolder

    emailPath = Environ$("Temp") & "\tmpEmail.msg"

    Dim attachPath$
    For i = objMailItemOriginal.Attachments.Count To 1 Step -1
        attachPath = tmpFolder & "\" & objMailItemOriginal.Attachments(i)
        objMailItemOriginal.Attachments(i).SaveAsFile attachPath

        objMailItemNew.Attachments.Add attachPath
        objMailItemOriginal.Attachments.Remove (i)
    Next

    objMailItemOriginal.SaveAs emailPath
    objMailItemOriginal.Close olDiscard

请有前景专家吗？

【问题讨论】：

标签： vba outlook

【解决方案1】：

我能想到的唯一方法是保存包含附件的电子邮件，然后从磁盘打开保存的电子邮件并使用其中的附件。

Sub workwithmail(pathfile As string)
Dim oNamespace As Outlook.NameSpace
 Set oNamespace = Application.GetNamespace("MAPI")
Dim oSharedItem As Outlook.mailitem
Dim pathfile As String
    Set oSharedItem = oNamespace.OpenSharedItem(pathfile)

  '''here Comes your code

    oSharedItem.Close (olSave)
    Set oSharedItem = Nothing
    Set oNamespace = Nothing
End Sub

【讨论】：

【解决方案2】：

不要从原始项目中删除附件。使用 MailItem.SaveAs 将消息保存为 MSG 文件，使用 Application.Session.OpenSharedItem 重新打开它（返回 MailItem 对象）并从该对象中删除附件。然后调用 MailItem.Save。

【讨论】：