跳到主要内容

如何在Outlook中的文件夹中重命名和保存电子邮件附件?

在Outlook中,您通常会收到带有附件的邮件,并且是否尝试重命名邮件的附件并将其保存在文件夹中,如下面的屏幕快照所示? 显然,您可以将它们保存到一个文件夹中并一一重命名,但是实际上,我有一个VBA代码,可以快速重命名具有相同名称的所有附件,然后保存在一个文件夹中。
doc重命名保存附件1

重命名附件并将其保存在文件夹中

使用 Kutools for Outlook 重命名并将附件保存在文件夹中


在Outlook中回复带有原始附件的邮件

众所周知,当您在Outlook中将邮件回复给收件人时,附件将从原始邮件中删除。 如果您想保留附件来回复按摩,可以尝试 Kutools for Outlook's 带附件回复 功能,它可以回复一封带有原始附件的邮件,也适用于所有messafe。    点击可使用全部功能60天免费试用!
 
doc附上回复
 
Kutools for Outlook:拥有数十个方便的 Outlook 插件,可在 60 天内免费试用,无任何限制。
Office 选项卡 - 在 Microsoft Office 中启用选项卡式编辑和浏览,让工作变得轻而易举
Kutools for Outlook - 通过 100 多个高级功能增强 Outlook,实现卓越效率
使用这些高级功能增强您的 Outlook 2021 - 2010 或 Outlook 365。 享受全面的 60 天免费试用并提升您的电子邮件体验!

重命名附件并将其保存在文件夹中

1.选择要保存其附件的邮件,然后重命名为相同的名称。

2。 按 Alt + F11 k嗯,然后在 Project1 窗格,双击 本次展望会议 在右侧部分创建一个新的空白脚本,然后将代码复制并粘贴到该脚本中。

VBA:重命名并保存附件

Public Sub SaveAttachsToDisk()
'UpdatebyExtendoffice20180521
Dim xItem As Object  'Outlook.MailItem
Dim xSelection As Selection
Dim xAttachment As Outlook.Attachment
Dim xFldObj As Object
Dim xSaveFolder As String
Dim xFSO As Scripting.FileSystemObject
Dim xFile As File
Dim xFilePath As String
Dim xNewName, xTmpName As String
Dim xExt As String
Dim xCount As Integer
On Error Resume Next
Set xFldObj = CreateObject("Shell.Application").browseforfolder(0, "Select a Folder", 0, 16)
Set xFSO = New Scripting.FileSystemObject
If xFldObj Is Nothing Then Exit Sub
xSaveFolder = xFldObj.Items.Item.Path & "\"
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xNewName = InputBox("Attachment Name:", "Kutools for Outlook", xNewName)
If Len(Trim(xNewName)) = 0 Then Exit Sub
For Each xItem In xSelection
    For Each xAttachment In xItem.Attachments
        xFilePath = xSaveFolder & xAttachment.FileName
        xAttachment.SaveAsFile xFilePath
        Set xFile = xFSO.GetFile(xFilePath)
        xCount = 1
        Saved = False
        xExt = "." & xFSO.GetExtensionName(xFilePath)
        xTmpName = xNewName
        xNewName = xTmpName & xExt
        If xFSO.FileExists(xSaveFolder & xNewName) = False Then
            xFile.Name = xNewName
            xNewName = xTmpName
        Else
            xTmpName = Left(xNewName, Len(xNewName) - Len(xExt))
            While Saved = False
                xNewName = xTmpName & xCount & xExt
                If xFSO.FileExists(xSaveFolder & xNewName) = False Then
                    xFile.Name = xNewName
                    xNewName = xTmpName
                    Saved = True
                Else
                    xCount = xCount + 1
                End If
            Wend
        End If
    Next
Next
Set xFSO = Nothing
End Sub

doc重命名将附件保存在文件夹2中

3。 点击 工具 > 参考资料,在弹出的对话框中,选中 Microsoft脚本运行时 复选框。

doc重命名将附件保存在文件夹3中 doc箭头向右 doc重命名将附件保存在文件夹4中

4。 点击 OK, 按 F5 运行代码的关键 浏览文件夹 弹出对话框,用于选择或创建用于放置附件的文件夹。
doc重命名将附件保存在文件夹5中

5。 点击 OK,然后为附件命名。
doc重命名将附件保存在文件夹6中

6。 点击 OK,现在附件将重命名为相同的名称,如果有重复项,则重复的附件将添加数字作为后缀。


使用 Kutools for Outlook 重命名并将附件保存在文件夹中

其实有一个功能 Kutools for Outlook -Outlook的便捷加载项工具可以在保存或发送之前重命名所有附件。

Kutools for Outlook , 包括  Microsoft Outlook 2016、2013、2010和Office 365的强大功能和工具。

免费安装 Kutools for Outlook,然后执行以下步骤:

1.根据需要在负窗格或“消息”框中激活电子邮件,单击 库工具 > 附件工具重命名全部.
doc重命名保存附件2

2.在弹出对话框中,键入用于每个附件的新名称。 请点击 OK,附件已使用新名称重命名。
doc重命名保存附件3 

3.右键单击一个附件,选择 保存所有附件,单击“ OK 然后选择一个文件夹以根据需要保存附件。 然后,已重命名的附件已保存在文件夹中。
doc重命名保存附件5 
doc重命名保存附件5


最佳办公生产力工具

Kutools for Outlook - 超过 100 种强大功能可增强您的 Outlook

🤖 人工智能邮件助手: 具有人工智能魔力的即时专业电子邮件——一键天才回复、完美语气、多语言掌握。轻松改变电子邮件! ...

📧 电子邮件自动化: 外出(适用于 POP 和 IMAP)  /  安排发送电子邮件  /  发送电子邮件时按规则自动抄送/密件抄送  /  自动转发(高级规则)   /  自动添加问候语   /  自动将多收件人电子邮件拆分为单独的消息 ...

📨 电子邮件管理: 轻松回忆电子邮件  /  按主题和其他人阻止诈骗电子邮件  /  删除重复的电子邮件  /  高级搜索  /  合并文件夹 ...

📁 附件专业版批量保存  /  批量分离  /  批量压缩  /  自动保存   /  自动分离  /  自动压缩 ...

🌟 界面魔法: 😊更多又漂亮又酷的表情符号   /  使用选项卡式视图提高 Outlook 工作效率  /  最小化 Outlook 而不是关闭 ...

👍 一键奇迹: 使用传入附件回复全部  /   反网络钓鱼电子邮件  /  🕘显示发件人的时区 ...

👩🏼‍🤝‍👩🏻 通讯录和日历: 从选定的电子邮件中批量添加联系人  /  将联系人组拆分为各个组  /  删除生日提醒 ...

超过 100特点 等待您的探索! 单击此处了解更多。

了解更多       免费下载      购买
 

 

Comments (4)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Thanks, it is ridiculous that we have to go to these lengths to do something that should be handled by the application
This comment was minimized by the moderator on the site
Hi! How can this work if having multiple emails? Is this only for multiple attachments in same email? Thanks!
This comment was minimized by the moderator on the site
Hey there! Do you know how we can improve the below code to rename the file when saved?

Public Sub UnzipFileInOutlook(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\acheng\Desktop"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder
Set objAtt = Nothing
Next
End Sub
This comment was minimized by the moderator on the site
Hello, Lipe, may be this code can help you.

Private Sub CopyToDefaultCalendarFld(ByVal Item As Object)
Dim xCopiedAppointment As Outlook.AppointmentItem
Dim xMovedAppointment As Outlook.AppointmentItem
Dim xMeeting As MeetingItem
Dim xApoint As AppointmentItem
On Error Resume Next
If Item.Class = olAppointment Then
Set xApoint = Item
Set xCopiedAppointment = xApoint.Copy
Set xMovedAppointment = xCopiedAppointment.Move(GMovedCalendarFolder)
If xApoint.Subject <> xMovedAppointment.Subject Then
If InStr(1, xMovedAppointment.Subject, "Copy: ") > 0 Then
xMovedAppointment.Subject = VBA.Replace(xMovedAppointment.Subject, "Copy: ", "", 1, 1)
xMovedAppointment.Save
End If
End If
ElseIf Item.Class = olMeetingRequest Then
Set xMeeting = Item
Set xCopiedAppointment = xMeeting.GetAssociatedAppointment(True).Copy
Set xMovedAppointment = xCopiedAppointment.Move(GMovedCalendarFolder)
If xMeeting.Subject <> xMovedAppointment.Subject Then
If InStr(1, xMovedAppointment.Subject, "Copy: ") > 0 Then
xMovedAppointment.Subject = VBA.Replace(xMovedAppointment.Subject, "Copy: ", "", 1, 1)
xMovedAppointment.Save
End If
End If
xCopiedAppointment.Delete
End If
Set xCopiedAppointment = Nothing
End Sub
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations