outlook 如何自动保存附件

一、前言

仅做一下记录，放置后边不好找

二、代码

Public Sub SaveAttach(Item As Outlook.MailItem)
    'MsgBox (Item.Subject)
    ReceivedTime = Format(Item.ReceivedTime, "yyyymmdd")
    FilePath = "d:\WorkFiles\" + Format(Item.ReceivedTime, "yyyy") + "\" + Format(Item.ReceivedTime, "mm") + "\" + ReceivedTime + "-秎ンン-" + Item.Subject
    'MsgBox (FilePath)
    Dim hasPath
    hasPath = dir(FilePath, vbDirectory)
    If hasPath = "" Then
        MkDir (FilePath)
    Else
        FilePath = FilePath + "_" + Format(Now, "hhmmss")
        MkDir (FilePath)
    End If
    'MsgBox FilePath
    'MkDir FilePath
    SaveAttachment Item, FilePath + "\"
    MsgBox "玂秎ン" + Item.Subject + "" + "いン"
End Sub
'保存附件
' path为保存路径，condition为附件名匹配条件
Private Sub SaveAttachment(ByVal Item As Object, path$, Optional condition$ = "*")
    Dim olAtt As Attachment
    Dim i As Integer
    If Item.Attachments.Count > 0 Then
    For i = 1 To Item.Attachments.Count
    Set olAtt = Item.Attachments(i)
    ' save the attachment
    If olAtt.FileName Like condition Then
    olAtt.SaveAsFile path & olAtt.FileName
    End If
    Next
    End If
    Set olAtt = Nothing
End Sub

三、调用

通过添加规则对所有收到的携带附件的邮件运行以上脚本即可。

如果你喜欢我的文章，欢迎来给我买咖啡，而且还可以买不止一杯。

捐赠支持作者！