Excel 使用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

像这样试试

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

选项显式
子保存邮件附件（）
可变偏角
Dim ns作为名称空间
Dim inb As文件夹
将itm设置为Outlook.MailItem
作为附件的文件
将文件路径设置为字符串“请像这样尝试

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

选项显式
子保存邮件附件（）
可变偏角
Dim ns作为名称空间
Dim inb As文件夹
将itm设置为Outlook.MailItem
作为附件的文件
Dim File\u路径为字符串“
。FileName
为我返回扩展名。您确认返回代码中带有
FileName
属性的扩展名了吗？没有，我该怎么做？
。FileName
为我返回扩展名。您确认返回代码中带有
FileName
属性的扩展名了吗？没有，我该怎么做？它工作正常，谢谢！但是，是否可以省略添加的文件名？它可以工作，谢谢！但是，是否可以忽略添加的文件名？