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。

Outlook保存附件与主题名称

1 个答案: