asked on

Excel/Outlook VBA - processing incoming emails

Hi

I have to distribute a spreadsheet application to over a hundred people.
Part of what it does is processes incoming emails. The code below is the Outlook code that
I have used on my development machine behind Outlook. How do I add code to the Excel spreadsheet that executes code when emails come in to process them in a similar way to the code below? I need this because I can't get to all the recipients to paste the code to Outlook

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

On Error GoTo EH

   Dim arrEID As Variant, varEID As Variant, olkItem As Object
   arrEID = Split(EntryIDCollection, ",")
   Dim Atmt As Attachment
   Dim FileName As String
   Dim MYDOC_DIR As String: MYDOC_DIR = Environ("userprofile") & "\Documents"
    
    For Each varEID In arrEID
        Set olkItem = Session.GetItemFromID(varEID)
        If olkItem.Class = olMail Then
            If InStr(olkItem.Subject, "Drilling Data") > 0 Then
                'Your code goes here'
                    For Each Atmt In olkItem.Attachments
                        FileName = MYDOC_DIR & "\Lesedi Drilling Data\" & Convert_Email(olkItem.SenderEmailAddress) & "_" & Atmt.FileName
                        Atmt.SaveAsFile FileName
                    Next Atmt
    
               oLoop
            End If
        If InStr(olkItem.Subject, "New Holes") > 0 Then
                'Your code goes here'
                    For Each Atmt In olkItem.Attachments
                        FileName = MYDOC_DIR & "\Lesedi Drilling Data\New Holes\" & Convert_Email(olkItem.SenderEmailAddress) & "_" & Atmt.FileName
                        Atmt.SaveAsFile FileName
                    Next Atmt
    
               oNewHole
            End If
        End If
    Next
    Set olkItem = Nothing
    Exit Sub
EH:
    MsgBox "There was an error processing an incoming email! " & Err.Description
End Sub

Open in new window

Rory Archibald

Do they all have the same version of Outlook?

SiddharthRout

>>> How do I add code to the Excel spreadsheet that executes code when emails come in to process them in a similar way to the code below?

AFAIK, You cannot do that. You cannot monitor the 'live' mails from Excel.

Sid

Rory Archibald

Sure you can! :)

SiddharthRout

Whoa! Then I am definitely interested :)

Sid

ASKER CERTIFIED SOLUTION

Rory Archibald

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SiddharthRout

I am solving a question in another thread. After that I am gonna try that code. Looks interesting. :)

Sid

Murray Brown

ASKER

Thanks Rory. What code would I have there to look for a match in the header

Rory Archibald

Your code already does that doesn't it?

SiddharthRout

Ok I am back.

A quick thought.

Excel has to remain open at all time for monitoring the email? Then that is the biggest drawback I guess?

I Googled on the code to monitor Outlook real time but couldn't find any code.

Sid

Murray Brown

ASKER

Thanks very much. Going to post a further related question. That worked really well

Rory Archibald

Your code would become something like:

Private Sub appOL_NewMailEx(ByVal EntryIDCollection As String)

On Error GoTo EH

   Dim arrEID As Variant, varEID As Variant, olkItem As Object
   arrEID = Split(EntryIDCollection, ",")
   Dim Atmt As Outlook.Attachment
   Dim FileName As String
   Dim MYDOC_DIR As String: MYDOC_DIR = Environ("userprofile") & "\Documents"
    
    For Each varEID In arrEID
        Set olkItem = appOL.Session.GetItemFromID(varEID)
        If olkItem.Class = olMail Then
            If InStr(olkItem.Subject, "Drilling Data") > 0 Then
                'Your code goes here'
                    For Each Atmt In olkItem.Attachments
                        FileName = MYDOC_DIR & "\Lesedi Drilling Data\" & Convert_Email(olkItem.SenderEmailAddress) & "_" & Atmt.FileName
                        Atmt.SaveAsFile FileName
                    Next Atmt
    
               oLoop
            End If
        If InStr(olkItem.Subject, "New Holes") > 0 Then
                'Your code goes here'
                    For Each Atmt In olkItem.Attachments
                        FileName = MYDOC_DIR & "\Lesedi Drilling Data\New Holes\" & Convert_Email(olkItem.SenderEmailAddress) & "_" & Atmt.FileName
                        Atmt.SaveAsFile FileName
                    Next Atmt
    
               oNewHole
            End If
        End If
    Next
    Set olkItem = Nothing
    Exit Sub
EH:
    MsgBox "There was an error processing an incoming email! " & Err.Description
End Sub

Open in new window

You will need a reference set to Outlook.

Murray Brown

ASKER

posted additional question
https://www.experts-exchange.com/questions/26880455/Excel-VBA-Looking-for-a-match-in-Outlook-header.html