Outlook添付ファイルをキーフレーズで並べ替え

Question

デスクトップ上の特定のフォルダに添付ファイル名のフレーズに基づいて添付ファイルを自動的に保存するために、いくつかの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 

おそらくより長く、それはする必要があります、その後ったらしいですが、私はあなたが私がしようとしているもののアイデアを得る期待しています。

Answer 1

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