VBA: Start Macro, when E-Mail arrives in shared Mailbox?

[Soda]

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

[georgiboy]

Perhaps the below will help, it goes into the 'ThisOutlookSession' module:

Option Explicit

Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
    Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
    Dim ShrdRecip As Outlook.Recipient: Set ShrdRecip = objectNS.CreateRecipient("YourSharedMailboxAddress@somewhere.com")
    Set inboxItems = objectNS.GetSharedDefaultFolder(ShrdRecip, olFolderInbox).Items
End Sub


Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    If InStr(UCase(Item.Body), "HI") > 0 Then
        macro_1
    End If
End Sub


Sub macro_1()
    MsgBox "Email with the word: HI was received"
End Sub

If a mail is received with the word "HI" in the body then macro_1 will fire.

Hope this helps

[Soda]

hmm... seems that this is the result of your vba-code:
https://prnt.sc/1uXa7hiWdw9V

JIPPPPPIIIIEEEEE it works.

Thank you so much.

There is a little mistake in the first line (linebreak after "Option Explicit" is missing)



Patrick

[georgiboy]

Glad it worked for you, I have corrected that in case others view the code.

Cheers,

George