[Outlook] vba-Code für shared-Mailbox
09.09.2022 17:54:47
Patrick
dank eurer Hilfe habe ich mein Outlook-Problem lösen können:
Beim Empfang einer E-Mail soll, wenn bestimmte Texte in der empfangenen E-Mail stehen, eine Fälligkeit berechnet und der Betreff geändert werden.
Den Code habe ich für andere, die Hilfe suchen, hier noch einmal gepostet. Funktioniert einwandfrei....
ABER
Wie schaffe ich es nun, dass der Code mein geteilten Postfach überwacht und die Mails ändert (und nicht in meinem Hauptaccount)?
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'Debug.Print
Dim objEMail, objEMailCopy As Object
Dim intInitial As Integer
Dim intFinal As Integer
Dim strEntryId As String
Dim intLength As Integer
Dim datVersanddatum, datFaelligkeit As Date
intInitial = 1
intLength = Len(EntryIDCollection)
intFinal = InStr(intInitial, EntryIDCollection, ",")
strEntryId = Strings.Mid(EntryIDCollection, intInitial, (intLength - intInitial) + 1)
Set objEMail = Application.Session.GetItemFromID(strEntryId)
If (InStr(objEMail.Subject, "Anzeigenschaltung ") > 0) Then
If (InStr(objEMail.Body, "Jobbörse: StepStone Ultimate") > 0) Then
Set objEMailCopy = objEMail.Copy
posDatum = InStr(objEMailCopy.Body, "Veröffentlichungsdatum: ")
datVersanddatum = CDate(Mid(objEMailCopy.Body, posDatum + 24, 10))
If Weekday(datVersanddatum) >= 5 Then
datFaelligkeit = datVersanddatum + 40 + (8 - Weekday(datVersanddatum)) ' wenn Wochenende, dann kommenden Montag setzen und 40 Tage addieren
Else
datFaelligkeit = datVersanddatum + 40
End If
If Weekday(datFaelligkeit) >= 6 Then
datFaelligkeit = datFaelligkeit - (7 - Weekday(datFaelligkeit)) ' Wenn Fälligkeit = Wochenende, dann Freitag setzen
End If
objEMailCopy.Subject = Right(objEMailCopy.Subject, Len(objEMailCopy.Subject) - 17)
objEMailCopy.Subject = "ULTIMATE: " & Format(datFaelligkeit, "dd.mm.yyyy") & " >> " & objEMailCopy.Subject
objEMailCopy.Save
End If
End If
End Sub
LG
Patrick