使用SenderName重命名已保存的附件

我正在使用VBA脚本将所有附件保存到文件夹。 我正在尝试重命名发件人的名称的文件名。 但是，当我尝试这个更改文件的格式。 如何在不改变文件格式的情况下使用发件人的名称重命名文件？

Sub Save_Mail_Attachment() '''''Variable declarions Dim ns As NameSpace Dim inb As Folder Dim itm As Outlook.MailItem Dim atch As Attachment '''''Variables Initialization Set ns = Outlook.GetNamespace("MAPI") Set inb = ns.GetDefaultFolder(olFolderInbox).Folders("Specified Folder") File_Path = "C:\Attachments\" '''''Loop Thru Each Mail Item For Each itm In inb.Items '''''Loop Thru Each Attachment For Each atch In itm.Attachments On Error Resume Next atch.SaveAsFile File_Path & atch.FileName Debug.Print itm.SenderName Next atch Next itm End Sub 

Answer 1

试试像这样…

 Option Explicit Sub Save_Mail_Attachment() '''''Variable declarions Dim ns As NameSpace Dim inb As Folder Dim itm As Outlook.MailItem Dim atch As Attachment Dim File_Path As String '<--- missing Dim SenderName As String ' <------ Add '''''Variables Initialization Set ns = Outlook.GetNamespace("MAPI") Set inb = ns.GetDefaultFolder(olFolderInbox).Folders("Specified Folder") File_Path = "C:\Attachments\" '''''Loop Thru Each Mail Item For Each itm In inb.Items '''''Loop Thru Each Attachment For Each atch In itm.Attachments ' On Error Resume Next SenderName = itm.SenderName '<----- Add atch.SaveAsFile File_Path & " " & SenderName & atch.FileName '<--- Add Debug.Print itm.SenderName Next atch Next itm End Sub 

编辑

是否有可能省略添加的文件名称

是的，你可以做这样的事情。

 Option Explicit Sub Save_Mail_Attachment() '''''Variable declarions Dim ns As NameSpace Dim inb As Folder Dim itm As Outlook.MailItem Dim atch As Attachment Dim File_Path As String ' <------ Dim SenderName As String ' <----- Dim Ext As String ' <----- '''''Variables Initialization Set ns = Outlook.GetNamespace("MAPI") Set inb = ns.GetDefaultFolder(olFolderInbox).Folders("Specified Folder") File_Path = "C:\Attachments\" '''''Loop Thru Each Mail Item For Each itm In inb.Items '''''Loop Thru Each Attachment For Each atch In itm.Attachments Ext = Right(atch.FileName, _ Len(atch.FileName) - InStrRev(atch.FileName, Chr(46))) '<---- SenderName = itm.SenderName '<------ atch.SaveAsFile File_Path & SenderName & Chr(46) & Ext '<---- Debug.Print itm.SenderName Next atch Next itm End Sub 

但请记住，如果您从同一个发件人那里得到多个附件的电子邮件，那么您将最终覆盖现有的文件。