让Outlook自动保存邮件中附件

时间:2024-03-02 09:22:28

1. 在VBA中编写模块代码,实现保存附件的功能

在Outlook中按Alt + F11调出VBA编辑器,贴入以下代码

Public Sub SaveAttach(Item As Outlook.MailItem)
    \'Declare variables
    Dim folderPath As String
    folderPath = "E:\attachments\"
    Dim condition As String
    condition = "*"

    Dim olAtt As Attachment
    Dim i As Integer

    \'Go through each attachments
    If Item.Attachments.Count > 0 Then
        For i = 1 To Item.Attachments.Count
            Set olAtt = Item.Attachments(i)
           
            \'Save the attachment if it matches the condition
            If olAtt.FileName Like condition Then
                olAtt.SaveAsFile folderPath & DateTime.Timer & "_" & olAtt.FileName
            End If
        Next
    End If
   
    Set olAtt = Nothing
End Sub

2. 新建规则,邮件接收后运行脚本

新建规则,第二步中勾选运行脚本,选择我们新建的脚本SaveAttach

3. 修改安全设置,允许脚本运行

重启Outlook使设置生效。