按顺序保存附件

Question

我正在尝试运行通过 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

Answer 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

Answer 2

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

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

*** Save File ***

Endif

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

如果将它放在 For Next 循环之前，您可以 select 多封电子邮件：

For Each Item In Application.ActiveExplorer.Selection

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

您也可以在电子邮件中将 link 添加到您的文件中：

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

玩得开心！

按顺序保存附件

Save attachments in order

vba

outlook

outlook-2010