タイトルに基づいてOutlook添付ファイルを自動的に保存する

Question

私は、さまざまなクライアントの会社のレポートを保持する1つのドライブフォルダを設定したいと考えています。当社の報告ソフトウェアはだけなので、私はGoogleで検索したファイルに保存するのではなく、電子メールに送信し、自動的にフォルダ

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
Dim dateFormat 
    dateFormat = Format(Now, "yyyy-mm-dd H-mm") 
saveFolder = "C:\Report Attachments\" 
    For Each objAtt In itm.Attachments 
     objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName 
      Set objAtt = Nothing 
    Next 
End Sub 

問題にすべての添付ファイルをダウンロードするには、コードのこの部分を見つけた私は会社によってレポートを分割したいということです。例えば、私はA社のレポートは

Cに行きたい：\報告書の添付が

Cに行くために会社Aに

とB社のレポートを\：\報告書の添付がB社

\します

など。各レポートはに添付ファイルのタイトルに会社名を付ける必要がありますので、添付ファイルのタイトルに基づいて保存場所を変更するコードを調整します。これは可能ですか？

Answer 1

メールが到着したら特定のフォルダに移動するルールを設定します（おそらく、メールアドレスドメインに基づいてルールを作成する）。 OutlookのThisOutlookSessionモジュールで

は、宣言セクションでこのコードを入力します。

Dim WithEvents CompanyA As Items 
Dim WithEvents CompanyB As Items 

Const COMPA_PATH As String = "C:\Report Attachments\Company A\" 
Const COMPB_PATH As String = "C:\Report Attachments\Company B\" 

Private Sub Application_Startup() 

    Dim ns As Outlook.NameSpace 
    Set ns = Application.GetNamespace("MAPI") 

    Set CompanyA = ns.Folders.item("Mailbox - tomdemaine") _ 
         .Folders.item("Inbox") _ 
         .Folders.item("CompanyA").Items 

    Set CompanyB = ns.Folders.item("Mailbox - tomdemaine") _ 
         .Folders.item("Inbox") _ 
         .Folders.item("CompanyA").Items 

End Sub 

Sub CompanyA_ItemAdd(ByVal item As Object) 

    Dim oAtt As Attachment 

    If item.Attachments.Count > 0 Then 
     For Each oAtt In item.Attachments 
      item.UnRead = False 
      'Note DisplayName may contain illegal characters. 
      oAtt.SaveAsFile COMPA_PATH & oAtt.DisplayName 
      DoEvents 
     Next oAtt 
    End If 

    Set oAtt = Nothing 

End Sub 

Sub CompanyB_ItemAdd(ByVal item As Object) 

    Dim oAtt As Attachment 

    If item.Attachments.Count > 0 Then 
     For Each oAtt In item.Attachments 
      item.UnRead = False 
      'Note DisplayName may contain illegal characters. 
      oAtt.SaveAsFile COMPB_PATH & oAtt.DisplayName 
      DoEvents 
     Next oAtt 
    End If 

    Set oAtt = Nothing 

End Sub 

コードがOutlookを起動するときにA社B社&フォルダを見て開始します。何かが添付ファイルを含む場所に移動すると、そのファイルはファイルの場所に保存され、電子メールは既読としてマークされます。

私はコードをテストしていません。あなたのニーズに合わせてOutlookのフォルダとファイルの場所を更新する必要があります。