保存 Outlook 附件并使用主题行中的标识符重命名/附加文件

Question

我对 VBA 非常陌生，需要一些帮助。我正在尝试编写一个 VBA 脚本（以及 Outlook 规则）来自动从每日电子邮件中下载附件，并将文件名附加到主题中出现的日期。

这就是主题行的样子 - “2014 年 10 月 20 日部门的电子邮件警报”。我只需要隔离指示文件运行日期的最右边的 10 个空格。

所以我在网上找到了可以自动下载附件并按当前日期附加的代码，这确实有效。见下文。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyymmdd ")
saveFolder = "Z:\Daily Emails"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

我还在网上发现这样的东西应该指向日期（格式如 XX/XX/XXXX 并且始终位于主题行的末尾。 Subject = Right(itm.Subject, 10) 但我无法将其合并到上面的代码中。

谁能帮帮我？这意味着很多

谢谢！

-克里斯蒂娜

Answer 1

使用 Rules 运行宏很好。
我以前使用相同的设置。问题是，如果您要处理新收到的邮件，sub 不会捕获它。如果您需要以 Email Alert for Department for mm/dd/yyyy 作为主题保存传入电子邮件的附件，请尝试改用事件。默认情况下，Outlook 不提供 Items Event，因此您必须创建它。

在您的 ThisOutlookSession（不在模块中）尝试类似：

Option Explicit
Private WithEvents olIBoxItem As Outlook.Items

---

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder

    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
    '~~> change olFolder depending on what folder you're receiving the email
    '~~> I assumed it is Outlook's default folder Inbox
    Set olIBoxItem = olFolder.Items
End Sub

---

Private Sub olIBoxItem_ItemAdd(ByVal Item As Object)
    Const strSub As String = "Email Alert for Department for "
    If TypeOf Item Is Outlook.MailItem Then
        Dim nMail As Outlook.MailItem
        Set nMail = Item

        If InStr(nMail.Subject, strSub) <> 0 Then
            Const savefolder As String = "Z:\Details Mail\"
            '~~> Extract your date
            Dim dateSub As String: dateSub = Right(nMail.Subject, 10)
            '~~> Make sure there is an attachment
            If nMail.Attachments.Count > 0 Then
                Dim olAtt As Outlook.Attachment
                Set olAtt = nMail.Attachments.Item(1) '~~> if you only have 1
                Dim attFName As String, addFExt As String
                '~~> Get the filename and extension separately
                attFName = Split(olAtt.Filename, ".")(0) 
                attFExt = Split(olAtt.Filename, ".")(1)
                '~~> Reconstruct the filename
                attFName = savefolder & attFName & " " & dateSub & attFExt
                '~~> Save the attachment
                olAtt.SaveAsFile attFName
            End If
        End If
    End If
End Sub

所以上面的例程会自动检查收件箱文件夹中收到的所有邮件。
如果主题包含指定的字符串。如果是，它会自动保存附件。
但是，如果您有多个附件，则必须查看并保存每个附件。
一开始可能看起来令人困惑，但您肯定会掌握它的窍门。 HTH。