利用VBA自动保存outlook附件

创建VBA方法如下：

Public p As String '文件保存位置，也是解压文件存放位置Public Sub SaveAttach(Item As Outlook.MailItem)    p = "C:\Users\Administrator.TXV6HLXTU3ZW8KD\Desktop\"    SaveAttachment Item, p, "*.rar"  '此处*.rar可以改成其他正则表达式    ' MsgBox "附件已保存"End Sub' 保存附件' path为保存路径，condition为附件名匹配条件Private Sub SaveAttachment(ByVal Item As Object, path$, Optional condition$ = "*")    Dim olAtt As Attachment    Dim i As Integer    Dim m As Long    Dim s As String    If Item.Attachments.Count > 0 Then        For i = 1 To Item.Attachments.Count            Set olAtt = Item.Attachments(i)            '保存文件            If olAtt.FileName Like condition Then                olAtt.SaveAsFile path & olAtt.FileName'以下部分为解压rar文件，p为保存位置                s = "C:\Program Files\WinRAR\WinRAR.exe" & " X " & path & olAtt.FileName & " " & p '注意找到解压软件位置                m = Shell(s, vbHide)            End If        Next    End If    Set olAtt = NothingEnd Sub

在outlook中新建规则，选择动作为执行脚本，选择脚本为此方法，即可实现收到邮件后自动保存附件并解压到桌面。