Automatisches Speichern von Outlook-Anhängen basierend auf dem Titel

Question

Ich möchte einen Ordner mit einem Laufwerk einrichten, der Berichte für verschiedene Kunden unserer Unternehmen enthält. Unsere Reporting-Software sendet nur eher an eine E-Mail als Speichern so zu Datei habe ich gegoogelt und fand dieses Stück Code automatisch in einen Ordner ist

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 

Die Frage alle Anhänge zum Download, dass ich die Berichte von Unternehmen teilen möchten . zum Beispiel möchte ich Berichte für Unternehmen A bis

C gehen: \ Report Attachments Firma A \

und Berichte für die Firma B zu

C zu gehen: \ Report Attachments Unternehmen B \

und so weiter. Jeder Bericht sollte den Firmennamen im Titel des Anhangs haben, also suche ich nach einer Änderung des Codes, um den Speicherort basierend auf dem Anhangstitel zu ändern. Ist das möglich?

Answer 1

Richten Sie eine Regel ein, um die E-Mails bei ihrem Eintreffen in bestimmte Ordner zu verschieben (wahrscheinlich basierend auf der E-Mail-Adressdomäne).

Im ThisOutlookSession Modul in Outlook diesen Code im Abschnitt Deklarationen eingeben:

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 

Der Code beginnt Ihre CompanyA & CompanyB Ordner zu beobachten, wenn Sie Outlook starten. Jedes Mal, wenn etwas dorthin verschoben wird, das Anhänge enthält, speichert es sie an Ihrem Speicherort und markiert die E-Mail als gelesen.

Ich habe den Code nicht getestet - und die Outlook-Ordner und Dateispeicherorte müssen aktualisiert werden, um Ihren Anforderungen zu entsprechen.