Hello dear vba forum.
I am new here and hope you can help me.
Unfortunately I only know a little Excel-VBA (and minimal PPT-VBA), that is: I can solve my problems and tasks partly by myself and sometimes I need an idea (from a forum), which brings me on the right way and I can almost solve my problem by myself.
Sometimes I just need someone to show me the code so I can learn something new again. So now I teach myself outlook vba - I peek at the others and learn from it.
Now this is my first outlook project and I have a question where I can't find the solution though and hope someone can show me how to do it.
My script:
I made myself a script that is always started when an email arrives. If it is an order with a certain word in the email body, then copy the mail and add the due date in the subject line.
The script (see below) works quite perfectly.
My problem:
However, it should now work with the shared mailbox in the same way, or rather, I actually need the script exclusively for the shared mailbox.
Can you help me?
Many thanks already...
Patrick
Sub Intialize_Handler()
Set outApp = Outlook.Application
End Sub
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 posDatum As Integer 'Position of the order date in the e-mail
Dim datVersanddatum, datFaelligkeit As Date 'order date, due 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, "New Order") > 0) Then
If (InStr(objEMail.Body, "Product: Ultimate") > 0) Then
Set objEMailCopy = objEMail.Copy
posDatum = InStr(objEMailCopy.Body, "Order-Date: ")
datVersanddatum = CDate(Mid(objEMailCopy.Body, posDatum + 24, 10))
If Weekday(datVersanddatum) >= 5 Then
datFaelligkeit = datVersanddatum + 40 + (8 - Weekday(datVersanddatum)) ' if weekend, then put next Monday and add 40 days
Else
datFaelligkeit = datVersanddatum + 40
End If
If Weekday(datFaelligkeit) >= 6 Then
datFaelligkeit = datFaelligkeit - (7 - Weekday(datFaelligkeit)) ' if due date = weekend, then set Friday
End If
objEMailCopy.Subject = Right(objEMailCopy.Subject, Len(objEMailCopy.Subject) - 17)
objEMailCopy.Subject = "Due Date: " & Format(datFaelligkeit, "dd.mm.yyyy") & " >> " & objEMailCopy.Subject
objEMailCopy.Save
End If
End If
End Sub