Consulting

Results 1 to 4 of 4

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

  1. #1
    VBAX Newbie
    Joined
    Sep 2022
    Posts
    2
    Location

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

    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

  2. #2
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    857
    Location
    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
    Last edited by georgiboy; 09-14-2022 at 05:36 AM. Reason: Error in pasting code
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

  3. #3
    VBAX Newbie
    Joined
    Sep 2022
    Posts
    2
    Location

    JIPPPPPIIIIEEEEE

    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

  4. #4
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    857
    Location
    Glad it worked for you, I have corrected that in case others view the code.

    Cheers,

    George
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •