08.10.2021, aktualisiert um 17:51:44 Uhr

3609

E-Mail aus Outlook 365 per Makro weiterleiten

Hallo liebe Leute ich muss das Thema nochmal rausziehen. Wir haben in unserem Outlook mehrere Postfacher ich möchte aber nur die Email aus einem der Postfacher weiterleiten könnt Ihr mir helfen das hier in meinen Code einzubauen bitte?

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Dim objMail_In As Outlook.MailItem
Dim objMail_Out As Outlook.MailItem
Dim aryEntryIDs() As String
Dim lngCount As Long

'jedes neue MailItem durchgehen  
aryEntryIDs = Split(EntryIDCollection, ",")  
For lngCount = 0 To UBound(aryEntryIDs)

Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
Set objMail_Out = objMail_In.Forward

With objMail_Out
.To = "MeineEmailadresse@Email.de"  
.Subject = "[AXA] " & objMail_In.Subject  
.Send
End With

Next lngCount

End Sub

Wäre schön wenn mir einer helfen kann Danke!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 1367202238

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

Ausgedruckt am: 23.11.2024 um 15:11 Uhr

25 Kommentare

Neuester Kommentar

Servus @wolfia, welcome back!

ich möchte aber nur die Email aus einem der Postfacher weiterleiten

Dafür gibt es im Outlook-Objektmodell die Eigenschaft SendUsingAccount des MailItem Objects mit der du bestimmen kannst über welchen Account die jeweilige eingetroffene Mail empfangen wurde.
Du kannst also mit einer einfachen IF-Abfrage verzweigen

' ...  
if objMail_In.SendUsingAccount.DisplayName = "Mein Postfach" then  
    ' ... hier mail forwarden  
End if
' ....  

Das Beispiel verwendet jetzt die DisplayName Property des Accounts, du kannst aber auch selbstverständlich eine andere Property des Accounts nehmen, z.B. die SmtpAddress Property zum Vergleichen einer Mail-Adresse statt dem DisplayName.

Grüße Uwe

Ok vielen Dank ich habe es mal so versucht:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Dim objMail_In As Outlook.MailItem
Dim objMail_Out As Outlook.MailItem
Dim aryEntryIDs() As String
Dim lngCount As Long

'jedes neue MailItem durchgehen
aryEntryIDs = Split(EntryIDCollection, ",")
For lngCount = 0 To UBound(aryEntryIDs)
if objMail_In.SendUsingAccount.DisplayName = "nur_dieses_postfach_soll_weitergeleitet werden@mail.de" then
Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
Set objMail_Out = objMail_In.Forward

With objMail_Out
.To = "an_diese_adresse_weiterleiten@mail.de"
.Subject = "[AXA] " & objMail_In.Subject
.Send
End With

Next lngCount

End Sub

Leider kommt hier nun bei Next IngCount eine Fehlermeldung.
Was mache ich Falsch?

Schau mal genau hin, da fehlt einerseits das "End If",
andererseits platzierst du die Abfrage vor dem deklarieren der Variablen "objMail_IN" die du ja prüfen willst, das kann so nur schief gehen 😉.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail_In As Outlook.MailItem
    Dim aryEntryIDs() As String
    Dim lngCount As Long

    'jedes neue MailItem durchgehen  
    aryEntryIDs = Split(EntryIDCollection, ",")  
    For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        If objMail_In.SendUsingAccount.DisplayName = "Mein Postfach" then  
            With objMail_In.Forward
                .To = "MeineEmailadresse@Email.de"  
                .Subject = "[AXA] " & objMail_In.Subject  
                .Send
            End With
        End if
    Next
End Sub

Vielen Lieben Dank,

ich werde das Montag gleich mal testen.
Wünsche euch noch einen schönes WE.

Zitat von @wolfia:
Wünsche euch noch einen schönes WE.

Gleichfalls 🎣

Guten morgen:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail_In As Outlook.MailItem
    Dim aryEntryIDs() As String
    Dim lngCount As Long

    'jedes neue MailItem durchgehen  
    aryEntryIDs = Split(EntryIDCollection, ",")  
    For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        If objMail_In.SendUsingAccount.DisplayName = "nutzer2@mail.de" Then  
            With objMail_In.Forward
                .To = "Empfaenger@mail.de"  
                .Subject = "[AXA] " & objMail_In.Subject  
                .Send
            End With
        End If
    Next
End Sub

So habe ich es nun eingebaut. In Outlook sind zwei Postächer eingerichtet:

Nuter1 und Nuter 2 es sollen nur die Mails von Nutzer 2 weitergeleitet werden.
Durch das Einfügen des Scriptes werden weder von Nutzer 1 noch von Nuter 2 die Mails weitergeleitet.

Ich habe vom Nutzer 2 die Email Adresse eingefügt habe es aber auch mit dem Namen probiert der in Outlook eingetragen ist. Beide Varianten funktionieren leider nicht.

Freue mich über Vorschläge......

If objMail_In.SendUsingAccount.DisplayName = "nutzer2@mail.de" Then

Der Name muss exakt mit der Darstellung in Outlook übereinstimmen (Groß- und Kleinschreibung muss in diesem Beispiel beachtet werden! Außerdem Wenn die SMTP Adresse verglichen werden soll muss auch die Property gewechselt werden

If objMail_In.SendUsingAccount.SmtpAddress = "nutzer2@mail.de" Then

Soll auch die Groß und Kleinschreibung egal sein dann so

If LCase(objMail_In.SendUsingAccount.SmtpAddress) = LCase("nutzer2@mail.de") Then

Ansonssten lass dir einfach die Properties in einer Messagebox ausgeben und vergleiche sie mit deinen Angaben

msgbox objMail_In.SendUsingAccount.SmtpAddress
msgbox objMail_In.SendUsingAccount.DisplayName

Beachte das bei Exchange Accounts nicht unbedingt die extern genutzte Adresse erscheint.

Das Skript funktioniert hier im Test problemlos, wenn man es denn mit den richtigen Daten füttert

So habe es nun so abgeändert:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail_In As Outlook.MailItem
    Dim aryEntryIDs() As String
    Dim lngCount As Long

    'jedes neue MailItem durchgehen  
    aryEntryIDs = Split(EntryIDCollection, ",")  
    For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        If LCase(objMail_In.SendUsingAccount.SmtpAddress) = LCase("nuter2@mail.de") Then  
            With objMail_In.Forward
                .To = "empfaenger@mail.de"  
                .Subject = "[AXA] " & objMail_In.Subject  
                .Send
                MsgBox objMail_In.SendUsingAccount.SmtpAddress
                MsgBox objMail_In.SendUsingAccount.DisplayName
            End With
        End If
    Next

End Sub

Leider wird keine Mail weitergeleitet und eine Message Box kommt auch keine.

Sehr seltsam.

Hast Du noch eine Idee?

Sehr seltsam.

Nee da ist nichts seltsam, die Message Box muss ja zum debuggen auch außerhalb der IF-Abfrage platziert werden (also zwischen Zeile 9 und 10), grundlegend etwas mitdenken kann man in einem Admin-Forum eigentlich erwarten

Entschuldigung ich habe leider vom scripten und programmierung wenig Ahnung, tut mir sehr leid aber ich bin eher beim einrichten und installieren firn. Also bitte nicht übel nehmen.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail_In As Outlook.MailItem
    Dim aryEntryIDs() As String
    Dim lngCount As Long

    'jedes neue MailItem durchgehen  
    aryEntryIDs = Split(EntryIDCollection, ",")  
    For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        If LCase(objMail_In.SendUsingAccount.SmtpAddress) = LCase("nutzer2@mail.de") Then  
            MsgBox objMail_In.SendUsingAccount.SmtpAddress
            MsgBox objMail_In.SendUsingAccount.DisplayName
            With objMail_In.Forward
                .To = "empfänger@mail.de"  
                .Subject = "[AXA] " & objMail_In.Subject  
                .Send
            End With
        End If
    Next

End Sub

So habe es nun so gemacht aber leider auch keine Message Box?

Wieder an der falschen Stelle! Ich hatte oben geschrieben in deinem Code zwischen Zeile 9 und 10. Denn wenn der Vergleich in der IF-Abfrage fehl schlägt weil der String nicht passt wird alles was darin steht ja nicht ausgeführt, somit auch die Messageboxen nicht, jetzt klar?
Sieht dann so aus

 For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        MsgBox objMail_In.SendUsingAccount.SmtpAddress
        MsgBox objMail_In.SendUsingAccount.DisplayName
        If LCase(objMail_In.SendUsingAccount.SmtpAddress) = LCase("nutzer2@mail.de") Then  

Wenn du also falsche Daten in den Vergleich einträgst kann die IF-Abfrage niemals erfolgreich sein und somit wird auch nichts weitergeleitet, verstanden?

Man sollte Code nie nur copy n pasten sondern auch selbst mal durchgehen und verstehen was da passiert.

Ja sorry wenn man da so wenig macht wie ich tut mir echt leid.
Also dann :

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim objMail_In As Outlook.MailItem
    Dim aryEntryIDs() As String
    Dim lngCount As Long

    'jedes neue MailItem durchgehen  
    aryEntryIDs = Split(EntryIDCollection, ",")  
    For lngCount = 0 To UBound(aryEntryIDs)
        Set objMail_In = Application.Session.GetItemFromID(aryEntryIDs(lngCount))
        MsgBox objMail_In.SendUsingAccount.SmtpAddress
        MsgBox objMail_In.SendUsingAccount.DisplayName
        If LCase(objMail_In.SendUsingAccount.SmtpAddress) = LCase("user@domain.tld") Then  
            With objMail_In.Forward
                .To = "xx@xxxx.de"  
                .Subject = "[AXA] " & objMail_In.Subject  
                .Send
            End With
        End If
    Next
End Sub

ok ich hab es dann so gemacht, aber Message Box kommt immer noch nicht. Sorry.

Dann sind bei dir die Makros im Sicherheitscenter global deaktiviert, dann kann das Event nie ausgeführt werden ...
Das also erst mal nachholen!

p.s. Bitte in Zukunft keine echten E-Mail Adressen hier im Forum posten und immer anonymisieren! Habe das mal für dich nachgeholt und anonymisiert.

Die Makros sind aktiviert. Wenn Outlook gesartet wird fragt er auch ob die gestartet werden sollen.

Ich habe nun die Email Adresse vom Nuter1 eingegeben dann kommt eine Message Box mit der Email Adresse. Aber für Nutzer 2 Klappt das nicht.

Mail für Nutzer 1 wird auch weitergeleitet.

MsgBox1
vorname.nachame@mail.de
MsgBox2
Vorname.Nachname@mail.de

genau so werden die Adressen angezeigt einmal erster Buchstabe groß einmal klein.

Entschuldigung habe vergessen die Mail Adresse zu ändern.
Danke für das ändern der Mail adresse.

Zitat von @wolfia:
Ich habe nun die Email Adresse vom Nuter1 eingegeben dann kommt eine Message Box mit der Email Adresse. Aber für Nutzer 2 Klappt das nicht.

Das kann so nicht sein, es müssen bei dem obigen Code für jede Mail zwei Messageboxen kommen egal was in der IF-Abfrage für eine Mailadresse steht. Denn diese stehen ja vor der If-Abfrage, sie müssen also kommen!

Mail für Nutzer 1 wird auch weitergeleitet.

Fragen dazu:

Wie sind die Konten eingerichtet? Sind es zwei separate Exchange-Konten, oder ist der andere Account über zusätzliche Konten öffnen in das erste eingebunden?

Obiges Skript funktioniert nur bei separat eingebundenen Konten, nicht über eine "delegated" eingebundene Mailbox, dafür muss man es weiter anpassen und die Empfänger-Adresse im Header prüfen checken und beim Forward dann statt über SendUsingAccount die Absender-Addresse explizit setzen.

Persönliche Anpassungen diesbezüglich nehme ich nur gegen entsprechende Aufwandsentschädigung per PN an.

Ja bei dem zweiten Konto handelt es sich um ein Stellvertreter Konto daher funktioniert das auch nicht. Ich habe Dir eine PN gesendet!

OK, in dem Fall kann das obige nicht funktionieren da die Stellvertreter-Mailbox kein aktives Konto in Outlook darstellt.

Hierzu muss man wenn man es wirklich über Outlook machen will (ich würde das über eine Transport-Regel oder EWS machen) einen anderen Ansatz nutzen und zwar das ItemsAdd Event der fremden Mailbox abonnieren.

WICHTIGE INFORMATIONEN (Bitte genau lesen!!)

Dazu füge man folgenden Code in den Code-Abschnitt DieseOutlookSitzung ein. Wichtig ist dabei das die Deklaration der globalen WithEvents Variable ganz oben im Codefenster steht.
In Zeile 19 muss natürlich noch der Name des Stores des Stellvertreters, und in der Sub inbox_items_ItemAdd die Forwarding-Parameter für die Mail angepasst werden. Zum Testen kann man auch das .Send für das Forwarding durch ein .Display ersetzt werden dann wird keine Mail verschickt sondern es geht nur das Fenster mit der Weiterleitung der Mail auf um sie zu überprüfen.
Abschließend muss Outlook zwingend neu gestartet werden damit die Eventhandler richtig gesetzt werden.

Damit das klappt sind natürlich wieder richtige Daten für den Namen des Stores des Stellvertreters anzugeben.

Dim WithEvents inbox_items As items

Private Sub Application_MAPILogonComplete()
    SubscribeFolderNewMail
End Sub

Private Sub inbox_items_ItemAdd(ByVal Item As Object)
    With Item.Forward
        .SUBJECT = "Test"  
        .To = "user@domain.tld"  
        .Send
    End With
End Sub

Sub SubscribeFolderNewMail()
    Dim s As store, userinbox As Folder
    
    For Each s In Application.Session.Stores
        If LCase(s.DisplayName) = LCase("user@domain.de") Then  
            Set userinbox = s.GetDefaultFolder(olFolderInbox)
            Exit For
        End If
    Next
    If Not userinbox Is Nothing Then
        Set inbox_items = userinbox.items
    End If
End Sub

Ich habe die Email-Adressen angepasst:

Dim WithEvents inbox_items As Items

Private Sub Application_MAPILogonComplete()
    SubscribeFolderNewMail
End Sub

Private Sub inbox_items_ItemAdd(ByVal Item As Object)
    With Item.Forward
        .Subject = "Test"  
        .To = "empfänger@mail.de"  
        .Send
    End With
End Sub

Sub SubscribeFolderNewMail()
    Dim s As Store, userinbox As Folder
    
    For Each s In Application.Session.Stores
        If LCase(s.DisplayName) = LCase("nutzer2@mail.de") Then  
            Set userinbox = s.GetDefaultFolder(olFolderInbox)
            Exit For
        End If
    Next
    If Not userinbox Is Nothing Then
        Set inbox_items = userinbox.Items
    End If
End Sub

Outlook neu gestartet aber funktioniert leider so nicht.

Ich habe die Email-Adressen angepasst:

Wie gesagt, es muss der Name des Stores angegeben werden, dieser ist also nicht unbedingt die Mail-Adresse! Prüfe das nach indem du dir die Namen ausgeben lässt!
Mit einem kleinen Makro lässt du dir den Namen jedes eingebundenen Stores ausgeben

Sub DisplayStores()
    for each s in Session.Stores
        msgbox s.DisplayName
    next
End sub

Habe den obigen Code hier mit deinem Szenario getestet, funktioniert hier einwandfrei.

Ich bin hiermit jetzt raus aus dem Thread, hat eh schon zu viel Zeit gekostet.

Viel Erfolg.

Grüße Uwe

Super jetzt klappt es Mega Klasse.
Es muss nicht die Mail Adresse rein sondern bei mir die wie der Name des Postfaches bzw. Stellvertreters ist.
Vielen Lieben Dank.
Eine kleine Sache wäre noch schön wenn bei Test auch noch der Betreff der weitergeleiteten Mail drin stünde. Lässt sich das noch machen?

Super Lieben Dank Perfekt. Schick mir dein PayPal Konto dafür geb ich gerne einen aus.

Zitat von @wolfia:
Eine kleine Sache wäre noch schön wenn bei Test auch noch der Betreff der weitergeleiteten Mail drin stünde. Lässt sich das noch machen?

Ja kein Problem dazu einfach die Subject Zeile im Forward folgendermaßen anpassen

.Subject = Item.Subject

Dann ist der Betreff der weitergeleiteten Mail = der eingegangenen Mail

Mega Klasse.

Vielen vielen Dank. Wie gesagt schick mir bitte noch eine PN das ich hier was in den Klingelbeutel geben kann.

Soviel Hilfsbereitschafft werde ich gern honorieren.