outlook 自动保存附件文档

ALT+F11, 点 insert -> module:

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

测试结果：

1．  若VB在保存时没有特别加用以区分文件名的随机函数（日期，tmp类似）

则OUTLOOK在自动保存文件附件时会以override方式保存；

2．  若保存时加了些区分名字，那假设一封邮件中含有相同文件名的附件

在自动保存时不会override;

3．  同时可以先判断路径内是否已有此文件，若无则自动保存，否则不保存；

如下为先判断再保存：

Public Sub SaveAttach(Item As Outlook.MailItem)
    'Declare variables
    Dim folderPath As String
    folderPath = "E:\attachments\"
    Dim condition As String
    condition = "*" 
   
    Dim dateformat
    dateformat = Format(Now, "yyyy-mm-dd H-mm")    
    Dim fullpath As String

    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            
                fullpath = folderPath & "\" & olAtt.FileName
                If Dir(fullpath) = "" Then
                   olAtt.SaveAsFile folderPath & olAtt.FileName
                End If
             'Next
            End If
        Next
    End If
    
    Set olAtt = Nothing
End Sub