Outlook VBA - NewMailEx mit zwei Postfächern

gelöstFrage VB for Applications Entwicklung

Hallo.

Outlook 2013, zwei Postfächer eingebunden, das betroffene Postfach ist das Hauptkonto.

Eingehende Mails in diesem Konto sollen auf den Absender geprüft werden. Bei entsprechendem Absender ist aus dem Body ein Code zu entnehmen, der als neuer Empfänger eingesetzt wird. Anschließend wird geprüft, ob dieser Empfänger in den Kontakten steht. Wenn ja - Mail senden. Wenn nein, Mail löschen.

Grundlegend arbeitet der Code so wie gewollt. Aber es treten Probleme auf, wenn bspw. aus dem zweiten Postfach eine Mail gerade bearbeitet wird und im Hauptpostfach eine neue Mail eintrifft. Dann versendet die Prozedur die Mail aus dem Zweitpostfach und nicht die neu bearbeitete Mail aus dem Hauptpostfach.

Mein VBA-Wissen hält sich in Grenzen. Die jetzige Lösung ist aus Codeschnipseln zusammen gesetzt, funktioniert soweit, kommt allerdings bei oben beschriebener Situation an seine Grenzen.

Kann mir evtl. bitte jemand einen Hinweis geben, was an dem Code geändert werden sollte, damit die Prozedur stabil läuft.?

Public WithEvents oApp As Outlook.Application

Private Sub Application_Startup()
    Set oApp = Application
End Sub

Private Sub oApp_NewMailEx(ByVal EntryIDCollection As String)
    Dim oNS         As NameSpace
    Dim oFolder     As MAPIFolder
    Dim oNewMailEx    As MailItem
    Dim objFwd As Outlook.MailItem
    Dim strAddr As String
    Dim Insp As Inspector
    Dim oRecip As Outlook.Recipient

   Set oNS = GetNamespace("MAPI")  
   Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
   Set oNewMailEx = oFolder.Items.oNewMailEx
'          On Error Resume Next  


   If (oNewMailEx.SenderName = "Sport frei") Then  

      If TypeName(oNewMailEx) = "MailItem" Then  
            If oNewMailEx.sender.GetExchangeUser.PrimarySmtpAddress = "sport@googlemail.com" Then  


                If Not oNewMailEx Is Nothing Then
                    strAddr = ParseTextLinePair(oNewMailEx.Body, "Der Teilnehmer")  
                        If strAddr <> "" Then  
                            Set objFwd = oNewMailEx.Forward
                            objFwd.To = strAddr & "FL"  
                            objFwd.CC = strAddr & "AM"  
'                            objFwd.Display  
                        Else
                            Set Insp = Nothing
                            Set oNewMailEx = Nothing
                            Set objFwd = Nothing

                        End If

                End If

                    Set Insp = Application.ActiveInspector
'                    Set objFwd = Insp.CurrentItem  


                        objFwd.Body = Replace(objFwd.Body, "-----Ursprüngliche Nachricht-----", "")  
                        objFwd.Body = Replace(objFwd.Body, "Von: Sport frei", "")  
                        objFwd.Body = Replace(objFwd.Body, "Gesendet: ", "")  
                        objFwd.Body = Replace(objFwd.Body, "Betreff: ", "")  
                        objFwd.Subject = Replace(objFwd.Subject, "WG: ", "")  

                    Set oRecip = Application.Session.CreateRecipient(strAddr & "FL")  
                        oRecip.Resolve
                If oRecip.Resolved Then
                    objFwd.Send
                    oNewMailEx.Delete
                Else
                    objFwd.Delete
                    oNewMailEx.Delete

                End If


        End If


    End If

   End If
    Set Insp = Nothing
    Set oNewMailEx = Nothing
    Set objFwd = Nothing
'    MsgBox "Neue Mails"  
    
    End Sub


Function ParseTextLinePair _
(strSource As String, strLabel As String)

    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer

    Dim intLenLabel As Integer
    Dim strText As String
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)

    If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)

    If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, 27, 5)
    Else
    If intLocCRLF = 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, 26, 5)

    Else
            intLocLabel = _
              Mid(strSource, intLocLabel + intLenLabel)
    End If
    End If
    End If
    ParseTextLinePair = Trim(strText)
End Function

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

Content-ID: 502135

Url: https://administrator.de/forum/outlook-vba-newmailex-mit-zwei-postfaechern-502135.html

Ausgedruckt am: 20.05.2025 um 18:05 Uhr

8 Kommentare

Neuester Kommentar

Hi,
Du kannst beim Senden mitgegeben, von welchem Konto es senden soll.

MailItem.SendUsingAccount property (Outlook)

E.

Ich habe mich hier leider nicht ganz deutlich ausgedrückt. Das Problem war nicht das Versenden mit falschem Absender, sondern das Versenden von komplett falschen Mails, falls beim Eingang einer neuen Mail gerade eine weitere Mail geöffnet ist.
Ich habe den Code überarbeitet und teste ihn gerade. Sollten doch noch Probleme auftreten, würde ich mich erneut melden.
Die EntryID hat mir dabei geholfen.

Vielen Dank emeriks, auch wenn Dein Vorschlag nicht ganz gepasst hat, bin ich ja dadurch auf die Lösung gekommen.
Danke.

Hallo,

ich bin neu in diesem Forum und der VB-Umgebung unter Outlook. Ich programmiere eher Arduino in C++ und nicht lachen, in Delphi für Windowsanwendungen.

Dieser Beitrag, auch wenn er schon sehr alt ist, erschien mir vom Thema her am treffensten.
Mir stellt sich ein Problem beim Auswerten des Empfänger-Postfachs in Outlook und habe schon seit tagen nach einer Lösung in allen möglichen Foren gesucht, um meine Verzweiflung hier noch einmal deutlich zu machen

Zu meinem verständnisproblem:
Ich verwende zwei E-Mail Adressen, bei denen beim Eintreffen der Mails auf unterschiedlichen Druckern ausgedruckt werden soll und anschließend die Mail in ein Ordner "Ausgedruckt" des jeweiligen Postfachs verschoben werden soll.

Leider ist dies ja nur auf dem Standard Drucker möglich mit einer Regel möglich. Ich möchte jedoch folgendes beim Eintreffen der Mails mit MailItem.NewmailEx() tun:

mail1@e-mail.com -> PrintOut zu Drucker1 danach in Ordner "Ausgedruckt" verschieben.
mail2@e-mail.com -> PrintOut zu Drucker2 danach in Ordner "Ausgedruckt" verschieben.

Mein zusammengeklauter und geflickter Code sieht mittlerweile in etwa so aus, bzw soll so aussehen:

Könnt ihr mich hierbei etwas unterstützen?

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
	Dim Item As Object
	Dim Email As String
	Dim strPrinter AS String

	destFolder = Zielordner im jeweiligen Postfach
	
	Set Item = Session.GetItemFromID(EntryIDCollection)

	'Empfänger E-Mail Adresse ermitteln  
	Email = Item.[EmpfängerEmailAddress]   		<------------------- unklar, ürsprünglich Item.SenderEmailAddress

	If Item.UnRead Then

		'Überprüfen, ob E-Mail mit bestimmtem Betreff  
		If Email = "mail1@e-mail.de" Then  		<------------------ evtl noch den Betreff prüfen, um Spams zu filtern  
			strPrinter = Application.ActivePrinter
	
			Debug.Print "Die Mail Adresse lautet: " + Email  
			Application.ActivePrinter = "Drucker1"  
	
			If Mail.PrintOut Then			    <------------------- unklar
				Mail.Move destFolder
			End If
			Application.ActivePrinter = strPrinter
		End If

		'Überprüfen, ob E-Mail mit bestimmtem Betreff   
		If Email = "mail2@e-mail.de" Then  		<------------------ evtl noch den Betreff prüfen, um Spams zu filtern  
			strPrinter = Application.ActivePrinter
	
			Debug.Print "Die Mail Adresse lautet: " + Email  
			Application.ActivePrinter = "Drucker2"  
	
			If Mail.PrintOut Then				<------------------- unklar
				Mail.Move destFolder    
			End If
			Application.ActivePrinter = strPrinter
		End If

		Item.UnRead = False 'Item als gelesen markieren <---------------- unklar  
	End If

End Sub

Hi,
Mail.Printout() ist keine Function und liefert also nichts zurück, was man mit "If ... then" auswerten könnte.

Du kannst das höchstens über die Fehlerbehandlung abfangen.

E.

Hallo,

Ok, danke für den Hinweis, war auch nur so Synonym bzw eine Idee, um das erfolgreiche Drucken abzufragen.

Aber zu meiner anderen Frage, hättest du da auch noch eine Idee für mich.
Zur Auswertung an welche Mail-Adresse die eingehende Mail war?

VG

Hallo,

ich bin es noch mal, habe jetzt endlich die Lösung gefunden, wie man die Empfangsadresse der neuen eingehenden Mail mit "NewMailEx()" herausfindet.

Die Antwort auf meine Frage Lautet:

.Recipients(1).Address

von mir aus auch als schleife, hier sind alle Adressaten der Mail hinterlegt, somit kann ich mir meine gesuchte Adresse filtern.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim EML As Object, ini As Integer, fin As Integer, sID As String, iLen As Integer
    Dim strAddr As String
    
    
    Debug.Print "NewMailEx"  
    Debug.Print , EntryIDCollection
    ini = 1
    iLen = Len(EntryIDCollection)
    sID = Mid(EntryIDCollection, ini, (iLen - ini) + 1)
    Set EML = Session.GetItemFromID(sID)
    
    Debug.Print "Empfänger Adresse(n):" + EML.Recipients(1).Address  '<----------- meine gesuchte Lösung  
End Sub

Deswegen stelle ich nicht so gerne fragen in Foren und habe auch mein Icon noch so gewählt um mich als unterwürfig zu zeigen.
Man bekommt in den meisten Foren leider nur infos und Rüffel zu Sachen die, die eigentliche Frage nicht betreffen,
oder nur "wer suchet der findet!" zu hören.

schade...

Trotzdem vielen Dank für deinen Beitrag und ich hinterlasse wenigstens noch meine Lösung, nach tagelanger Suche im Netz, was auch nicht immer selbstverständlich ist.

Nicht böse gemeint, nur als kleine Anmerkung zum nachdenken.

Nichts für ungut...

Äh ... ja ...
Dein ursprünglicher Text hat als Frage nur

Könnt ihr mich hierbei etwas unterstützen?

Ich dachte, das hätte ich mit meiner Antwort getan.

Und - es wird hier im Forum (und auch in vielen anderen) nicht gerne gesehen, wenn andere Threads für eigene Fragen gekapert werden. Besser wäre es gewesen, eine eigene Frage zu eröffnen, dann gerne mit Link auf andere, auch ältere Threads innerhalb dieses Forums.

Auch nicht böse gemeint.

Ok, wie gesagt, ich bin nicht so Foren konform.
Ich werde mich versuchen da noch ein wenig rein zu lesen, damit ich das in Zukunft besser platzieren kann.

gelöstFrage VB for Applications Entwicklung

Heiß diskutiert