本文章提供了一个使用VBA编写的自动化脚本，旨在帮助Outlook用户自动保存收到或发送的邮件及其附件到指定文件夹中，提高办公效率。
Outlook VBA 自动保存邮件及附件的代码可以帮助用户在接收新邮件时自动将邮件及其附件保存到指定位置。这种自动化工具可以大大提高工作效率，特别是在需要频繁处理大量电子邮件的情况下。使用VBA编写此类脚本通常涉及监听特定文件夹的新邮件事件，并通过编程方式访问这些新邮件以提取其内容和附件。
要实现这一功能，首先需要在Outlook中启用宏并设置信任中心允许运行所有宏的项目或模板。然后可以创建一个包含所需代码的新模块。以下是一个简单的示例：
1. 打开 Outlook 并按 Alt + F11 进入 VBA 编辑器。
2. 在“插入”菜单中选择新模块，并在其中输入所需的代码。
下面提供了一个基本的VBA脚本框架，用于监听收件箱中的新邮件并自动保存附件：
```vba
Public WithEvents olInboxItems As Outlook.Items
Private Sub Application_Startup()
Set olInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Dim mail As MailItem
Set mail = Item
检查邮件中是否包含附件
If mail.Attachments.Count > 0 Then
SaveAttachmentsToDisk mail, C:\Path\To\Saved\Folder\ & Format(mail.ReceivedTime, yyyy-mm-dd_hhnnss)
End If
End If
End Sub
Sub SaveAttachmentsToDisk(ByVal Item As Outlook.MailItem, ByVal FolderName As String)
Dim objAtt As Attachment
Dim strFileSaveAs As String
创建文件夹（如果不存在）
CreateFolderIfNotExist(FolderName)
For Each objAtt In Item.Attachments
strFileSaveAs = FolderName & \ & objAtt.FileName
保存附件到指定路径
objAtt.SaveAsFile (strFileSaveAs)
Next
End Sub
Sub CreateFolderIfNotExist(ByVal Path As String)
If Not FolderExists(Path) Then MkDir Path
End Sub
Function FolderExists(ByVal Path As String) As Boolean
On Error Resume Next
FolderExists = ((GetAttr(Path) And vbDirectory) <> 0)
End Function
```
以上代码展示了如何监听新邮件、检查附件并将其保存到指定目录。请根据实际需求调整路径和其他参数。
注意：在使用任何自动化脚本时，都应谨慎处理个人和敏感信息，并确保遵守所有适用的隐私政策和法律法规。
5星
