kineas
Goto Top

Outlook 2010 Dateianhänge von bestimmten Exchange Mails in Ordner verschieben

Hallo,

in Anlehnung an den Beitrag
Outlook 2003: Datei aus Mailanhang automatisch in Ordner verschieben oder kopieren
habe ich den Code eingebaut und er funktioniert auch.
Allerdings nur bei externen E-Mails.
Bei internen Exchange Mails funktioniert .SenderEmailAddress nicht.
Es kommt nur so etwas wie:
/O=xx/OU=CN37/CN=RECIPIENTS/CN=Username
und nicht die E-Mailadresse.
Wir haben hier mehrere Reports, die automatisch von verschiedenen SMTP und Exchange-Maschinenaccounts versendet werden.
Diese Anhänge müssen (um Recourcen zu schonen) in einen Ordner im Firmennetz kopiert werden.

Gibt es eine Möglichkeit, dass bei der Abfrage auch die SMTP-E-Mail Adresse aus Exchange ermittelt wird ?
Serveränderungen scheiden aus.
Hier der Code:

Sub application_NewMail()
Dim strNewFolder As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim oAttachment As Attachment
Dim WshShell As Object
Dim strDesktop As String

Set WshShell = CreateObject("WScript.Shell")  
strDesktop = WshShell.SpecialFolders("Desktop")  

strNewFolder = strDesktop & "\" & Format(Date, "yyyymmdd")& "-" & Format(Time, "hhmm") & "_Scandaten"  
On Error GoTo check_error
MkDir(strNewFolder)

objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each Item In objPosteingang.Items
    If Item.Class = olMail Then
        objNewMail = Item
        With objNewMail
            'If .SenderEmailAddress = "Report1@intern.de"  Or  .SenderEmailAddress = "Report2@extern.de"  Or .SenderEmailAddress = "Report3@intern.de" Then 'um nur Mails eines bestimmten Absenders zu bearbeiten, Kommentar entfernen (und Absenderadresse anpassen ;-))  
                If .UnRead = True Then
                    intanlagen = .Attachments.Count
                    Debug.Print objNewMail & ": "; intanlagen   
                    For i = 1 To intanlagen 'If davor eingespart: wenn intanlagen < 1 ist, wird die Schleife ohnehin nicht ausgeführt ...  
                        oAttachment = .Attachments.Item(i)
                        oAttachment.SaveAsFile(strNewFolder & "\" & oAttachment.FileName)  
                    Next
                End If
            'End If 'um nur Mails eines bestimmten Absenders zu bearbeiten, Kommentar entfernen  
        End With
    End If
Next Item
MsgBox("Alle Anhänge gespeichert.", vbOKOnly, "Verarbeitung fertig")  
Exit Sub

check_error:
Debug.Print Err.Number; Err.Description 
Err.Clear()
Resume Next

End Sub

Danke für die Hilfe

Grüße
Kineas

Content-Key: 307743

Url: https://administrator.de/contentid/307743

Ausgedruckt am: 19.03.2024 um 05:03 Uhr

Mitglied: emeriks
emeriks 21.06.2016 um 08:35:43 Uhr
Goto Top
Hi,
das ist der legacyEchangeDN. Nach diesem könntest Du einfach im AD suchen.

  strExchDN = "/O=xx/OU=CN37/CN=RECIPIENTS/CN=Username"  
  strUserDN = ""  
  strSMTPaddress = ""  
  
  Set objRootDSE = GetObject("LDAP://RootDSE")   
  strForest = objRootDSE.Get("rootDomainNamingContext")   

  Set ADOcon = CreateObject("ADODB.Connection")  
  ADOcon.Provider = "ADsDSOObject"  
  ADOcon.Open "Active Directory Provider"  
  Set ADOcmd = CreateObject("ADODB.Command")  
  Set ADOcmd.ActiveConnection = ADOcon
  ADOcmd.CommandText = "SELECT distinguishedName from 'GC://" & strForest & "' where legacyExchangeDN='" & strExchDN & "'"  
  Set ADOrec = ADOcmd.Execute

  With ADOrec
    If Not .EOF Then
      strUserDN = .Fields("distinguishedName").Value  
      Set objUser = GetObject("LDAP://" & strUserDN)  
      strSMTPaddress = objUser.Get("mail")  
    End If
  End With
  
  Set objRootDSE = Nothing 
  Set ADOrec = Nothing
  Set ADOcmd = Nothing
  Set ADOcon = Nothing

E.
Mitglied: 129813
129813 21.06.2016 aktualisiert um 09:38:14 Uhr
Goto Top
Hi,
have a look at
Outlook 2010 Marco Empfängermailadresse(n) auslesen - nicht Anzeigename
where the to-address is extracted from the header, could be modified with the regex to extract the sender mail.

Regards
Mitglied: Kineas
Kineas 21.06.2016 aktualisiert um 12:39:32 Uhr
Goto Top
Hey emeriks,

danke für die superschnelle Antwort.
Mit Sicherheit wäre das ein Weg, wenn ich Zugriff auf das AD hätte.
Ich weiß aber die ExchDN nicht.

Eigentlich möchte ich nur ein Exchange-Synonym für .SenderEmailAdress finden.

Oder noch einfacher:
Wie kann ich mein Postfach nach Mails von
3 bestimmten Exchange (mit distinguished Namen)- und/oder SMTP (mit normalen E-Mail Adressen)-Usern
abfragen um deren Anhänge zu separieren ?

Danke für die Hilfe

Grüße
Kineas
Mitglied: emeriks
emeriks 21.06.2016 aktualisiert um 12:49:33 Uhr
Goto Top
Hä?
Du schreibst doch, Du bekommst eine Adresse wie "/O=xx/OU=CN37/CN=RECIPIENTS/CN=Username". Das ist der legacyExchangeDN. Und nach diesem kannst Du im AD suchen, denn Du hast hier ganz offensichtlich ein Exchange Postfach, und dieses benötigt AD. AD abfragen darf standardmäßig jeder Benutzer. Dafür muss er kein Admin sein. Also einfach mal ausprobieren.

Eigentlich möchte ich nur ein Exchange-Synonym für .SenderEmailAdress finden.
"Exchange-Synonym": Was soll das sein? Der Aliasname? Anzeigename? Oder doch die SMTP-Adresse? Letzteres liefert Dir mein Ansatz bereits. Die anderen beiden kann man damit aber auch abfragen.
strAlias = objUser.Get("mailNickname")  
strDisplayName = objUser.Get("displayName")  
Mitglied: Kineas
Kineas 21.06.2016 um 14:14:32 Uhr
Goto Top
Ich glaube ich habe mich da ungeschickt ausgedrückt ...
emeriks schrieb:
Du schreibst doch, Du bekommst eine Adresse wie "/O=xx/OU=CN37/CN=RECIPIENTS/CN=Username".
Ich bekomme gar nichts zurück, da ich nur nach einer SMTP-Adresse frage der Sender aber nur einen Exchange-Namen hat.
Somit war das eher eine Schlussfolgerung von mir ...
In Wahrheit passiert einfach nichts.

Ich schrieb:
Eigentlich möchte ich nur ein Exchange-Synonym für .SenderEmailAdress finden.
emeriks schrieb:
"Exchange-Synonym": Was soll das sein? Der Aliasname? Anzeigename? Oder doch die SMTP-Adresse? Letzteres liefert Dir mein Ansatz bereits. Die anderen beiden kann man damit aber auch abfragen.
Mit Exchange-Synonym meinte ich, einen distinguished-Name Ersatzbefehl für die SMTP-Abfrage .SenderEmailAddress
Ich musste mittlerweile lernen, dass es so einen einfachen Befehl nicht gibt.

Ich schrieb:
Wie kann ich mein Postfach nach Mails von
3 bestimmten Exchange (mit distinguished Namen)- und/oder SMTP (mit normalen E-Mail Adressen)-Usern
abfragen um deren Anhänge zu separieren ?
Das war mein eigentliches Ansinnen.

Asche über mein Haupt.
Danke für deinen Ansatz, der mit das Sinnvollste war was ich bisher darüber gelesen habe.
Das werde ich ich meinen Code einbauen und testen.

Grüße Kineas