Outlook按关键短语排序附件

时间:2016-09-30 14:33:41

标签: vba outlook-vba

我正在尝试运行一些VBA代码,以根据附件名称中的短语自动将附件保存到桌面上的特定文件夹。

   Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
     For Each objAtt In itm.Attachments
        If objAtt.SaveAsFile = "Test1" Then
            saveFolder = "P:\Desktop\Reports\Test1"
        If objAtt.SaveAsFile = "Test2" Then
            saveFolder = "P:\Desktop\Reports\Test2"
        If objAtt.SaveAsFile = "Test3" Then
            saveFolder = "P:\Desktop\Reports\Test3"
        If objAtt.SaveAsFile = "Test4" Then
            saveFolder = "P:\Desktop\Reports\Test4"
        If objAtt.SaveAsFile = "Test5" Then
            saveFolder = "P:\Desktop\Reports\Test5"
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub

它可能需要更长时间,但我希望你能理解我想要做的事情。

1 个答案:

答案 0 :(得分:0)

Instr将指示该短语是否在Displayname中。

Private Sub saveAttachtoDisk(itm As mailItem)

    Dim objAtt As attachment
    Dim saveFolder As String

    For Each objAtt In itm.Attachments

        saveFolder = ""
        Debug.Print objAtt.DisplayName

        If InStr(LCase(objAtt.DisplayName), LCase("Test1")) > 0 Then
            saveFolder = "P:\Desktop\Reports\Test1"
        End If

        If InStr(LCase(objAtt.DisplayName), LCase("Test2")) > 0 Then
            saveFolder = "P:\Desktop\Reports\Test2"
        End If

        ' ....

        If saveFolder <> "" Then
            objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        Else
            MsgBox "No match. " & objAtt.DisplayName & " not saved."
        End If
    Next

    If objAtt Is Nothing Then
         Debug.Print "objAtt is already Nothing."
    Else
        MsgBox "Somehow objAtt was not nothing."
        Set objAtt = Nothing
    End If

End Sub