按顺序保存附件答案

【问题标题】：Save attachments in order按顺序保存附件
【发布时间】：2015-09-28 07:27:49
【问题描述】：

我正在尝试通过 Outlook 中的规则运行将附件保存到文件夹中的宏。

电子邮件有时包含多个附件。我正在尝试按顺序保存文件，例如，如果我查看电子邮件，我可以很容易地看到与之对应的文件。

我在网上找到了以下内容：

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "C:\PathToDirectory\"

    Dim dateFormat As String
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
    Next

End Sub

我试过玩objatt.displayname，但没有成功。我已经尝试分配新名称并创建一个新循环来命名文件 File 1 ， File 2 等等，但是当我这样做时，我会丢失文件扩展名。

更新版本：

Option Explicit

Public Sub save_attachments(itm As Outlook.MailItem)

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strExt As String
Dim i As Long
Dim savefolder As String

i = 1

savefolder = "C:\Users\w\desktop\test"

For Each objAtt In itm.Attachments
    i = i + 1
    strExt = fso.GetExtensionName(objAtt.DisplayName)
    objAtt.SaveAsFile savefolder & "\" & dateFormat & " - File " & i & "." & strExt
Next

End Sub

【问题讨论】：

标签： vba outlook outlook-2010

【解决方案1】：

您可以在现有子例程中执行类似的操作。这将增加一个"File" 号码并仍然保留扩展名。

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim strExt As String
Dim i As Long

For Each objAtt In itm.Attachments
    i = i + 1
    strExt = fso.GetExtensionName(objAtt.DisplayName)
    objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - File " & i & "." & strExt
Next

【讨论】：

我试过了，它只保存了一份文件。它不会遍历所有这些。我添加了保存文件夹路径。
嗯。 For Each 应该迭代每个附件。你确定你处理的MailItem有多个附件吗？
并非所有人都有多个附件。其中一些是单身。无论电子邮件中有多少附件，我都想将它们命名为 file1 2 3。
应该这样做。循环与之前相同。如果它以前有效，它现在应该有效。也许您可以编辑您的问题并附加您的最新代码。
我刚刚更新了我的原始帖子。这真的很奇怪，因为如果发送电子邮件的人在签名中有图片，它也在导出。

【解决方案2】：

一段时间以来，我一直在使用类似的解决方案。我最近添加了这种和平编码以避免保存嵌入的图像：

Extension = LCase$(Right$(FileNm, 3))
If Extension = "png" Or Extension = "gif" Or Extension = "jpg" Then 

*** Save File ***

Endif

当然假设您没有收到要保存的图像文件。

如果你把它放在你的 For Next 循环之前，你可以选择多个电子邮件：

For Each Item In Application.ActiveExplorer.Selection

当然你也必须把你的 i = i + 1 放在别的地方。

您也可以在电子邮件中添加指向您文件的链接：

FileNameb = Replace(filename, " ", "%20")
Link = "<a href=" + FileNameb + ">" + filename + "</a><br />"
Item.HTMLBody = Item.HTMLBody + Link

这会从邮件中删除附件并保存：

For i = 1 To Item.Attachments.Count
    Item.Attachments.Remove 1: 'Remove all attachments
Next i
Item.UnRead = False: 'Mark e mail as read
Item.Save

玩得开心！

【讨论】：