带有主题名称的 Outlook 保存附件

Question

我有一个宏，可以将收件箱中电子邮件的所有附件保存到指定目录。但是，我想以电子邮件主题作为文件名保存附件。

这是我的第一个宏，也是第一次查看 VBA，因此非常感谢任何指针。

Private Sub Outlook_VBA_Save_Attachment()
    ''Variable declarions
    Dim ns As NameSpace
    Dim inb As Folder
    Dim itm As MailItem
    Dim atch As Attachment

    ''Variables Initialization
    Set ns = Outlook.GetNamespace("MAPI")
    Set inb = ns.GetDefaultFolder(olFolderInbox)
    File_Path = "H:\Notes\"

    ''Loop Thru Each Mail Item
    For Each itm In inb.Items

    ''Loop Thru Each Attachment
        For Each atch In itm.Attachments
            If atch.Type = olByValue Then
               atch.SaveAsFile File_Path & atch.FileName
            End If
        Next atch
    Next itm

    '''''Notify the Termination of Process
    MsgBox "Attachments Extracted to: " & File_Path
End Sub

Answer 1

你需要做的就是改变一行：

atch.SaveAsFile File_Path & itm.Subject

要包含原始文件扩展名，您可以使用 FileSystemObject 来获取它。修改后的代码如下：

Private Sub Outlook_VBA_Save_Attachment()
    ''Variable declarions
    Dim ns As Namespace
    Dim inb As Folder
    Dim itm As MailItem
    Dim atch As Attachment
    Dim fso As FileSystemObject

    ''Variables Initialization
    Set ns = Outlook.GetNamespace("MAPI")
    Set inb = ns.GetDefaultFolder(olFolderInbox)
    File_Path = "H:\Notes\"
    Set fso = New FileSystemObject

    ''Loop Thru Each Mail Item
    For Each itm In inb.Items

    ''Loop Thru Each Attachment
        For Each atch In itm.Attachments
            If atch.Type = olByValue Then
               atch.SaveAsFile File_Path & itm.Subject & "." & fso.GetExtensionName(atch.Filename)
            End If
        Next atch
    Next itm

    '''''Notify the Termination of Process
    MsgBox "Attachments Extracted to: " & File_Path
End Sub

这需要参考 Microsoft Scripting Runtime。