Pull Specific Data from Email Body/none constant variable

Hi Team,

So, I am pretty new to VBA but I feel after reading all the various forums, there is a way to do what I am trying to attempt.

I need to be able to pull specific Data from a specific email sender.

However, once the code finds the unique identifier phrase, the data after that will vary every time and be different.

Here's an example.

When I get an email from "Registration", I would like to have data in the body following the Phrase "We were unable to approve because xxxxxx is invalid"

The "xxxxxx" is what i am ultimately trying to pull and is never the same.

Any help would be greatly appreciated.

You haven't said what you want to do with the xxxxxx when you find it, but the following should point you in the right direction. Select a message and run the testcode macro. If that works for you then you can use the main macro as a script with a rule to process the messages as they arrive. You will have to process the string as required where there is currently a message box

Code:

---

Option Explicit

Sub TestCode()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    GetData olMsg
lbl_Exit:
    Exit Sub
End Sub


Sub GetData(olItem As Object)
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim strData As String
    If TypeName(olItem) = "MailItem" Then
        On Error Resume Next
        With olItem
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(findText:="We were unable to approve because * is invalid", MatchWildcards:=True)
                    strData = oRng.Text
                    strData = Replace(strData, "We were unable to approve because ", "")
                    strData = Replace(strData, " is invalid", "")
                    'do something with strdata e.g.
                    MsgBox strData
                    Exit Do
                Loop
            End With
        End With
    End If
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub

---

Hello gmayor and thank you for your quick reply!

Yes, i should have given more detail on what i am trying to accomplish so i apologize.

Basically, i would like to be able to run a macro under a selected folder that will search for the following lines:
"We are unable to approve your deal registration request for the following reason"
or
"The following deal has been approved and associated to one of your accounts"

Once either one of those emails have been found/pulled, I want to pull the specific number in the email "Deal ID: xxxxxxxx"

The "xxxxxxxx" number is ultimately what i am trying to pull from either one of those abo same and never duplicates and that number is the one i am trying to export into an Excel file from the macro.

You can do that with a small modification e.g. as follows. Put the messages to be searched in an Outlook folder, select the folder from the macro prompt and the function will search the messages in that folder for whatever xxxxxx is and adds unique items to a collection. You can then write the items in that collection to your worksheet in place of Debug.Print

Code:

---

Option Explicit

Sub ExtractData()
Dim olFolder As Folder
Dim olMsg As Object
Dim Coll As Collection
Dim strData As String
Dim lngCol As Long
    Set olFolder = Session.PickFolder
    Set Coll = New Collection
    For Each olMsg In olFolder.Items
        If TypeName(olMsg) = "MailItem" Then
            On Error Resume Next
            strData = GetData(olMsg)
            If Not strData = "" Then
                Coll.Add strData, strData
            End If
        End If
    Next olMsg
    'write the items in the collection to your worksheet here
    For lngCol = 1 To Coll.Count
Debug.Print Coll(lngCol)
    Next lngCol
lbl_Exit:
    Set olFolder = Nothing
    Set olMsg = Nothing
    Set Coll = Nothing
    Exit Sub
End Sub


Private Function GetData(olItem As Object) As String
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim strData As String
    On Error Resume Next
    With olItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:="We were unable to approve because * is invalid", MatchWildcards:=True)
                strData = oRng.Text
                strData = Replace(strData, "We were unable to approve because ", "")
                strData = Replace(strData, " is invalid", "")
                'do something with strdata e.g.
                GetData = strData
                Exit Do
            Loop
        End With
    End With
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olItem = Nothing
    Exit Function
End Function

---

Hi Graham - again, thank you so much for taking the time to help me with this. I guess i am not as good at this as i thought....

Here are my questions:Here's an example email of exactly what data i am trying to pull:

"
The following deal has been approved and associated to one of your accounts:
Deal ID: XXXXXXXX
"

What i need the macro to do, is search the folder for any emails that have "The following deal has been approved and associated to one of your accounts:" and then export the number (XXXXXXXX) that comes after "Deal ID:" The XXXXXXXX is going to be different for each email. That variable is not constant but is always 8-digits.Would i run this macro from Outlook, or run it from Excel?

Also, there is a light blue border around the text, so I am not sure if that effects the macro's ability to pull the data. The border is not an embedded image. Below is a screenshot from the border that is around the text. It's the blue line.
Attachment 23751
Again, i really appreciate you taking the time to help me on this.

(Using Office 365)
Hi Graham,

I found this alternative code which i think may work. But the problem i am having, is when it searches in the folder i select, i need it to pull any email that has these two lines in the subject "Opportunity Approved" or "Opportunity Declined". Those two lines in the subject will always remain the same but what comes after them, is always different.

Here's the code i am working on:

ub GetDataFromEmailBody()
Dim ws As Worksheet
Dim olApp As Outlook.Application
Dim NS As Outlook.Namespace
Dim oFolder As Outlook.Folder
Dim Item, Items As Outlook.Items
Dim BodyTxt() As String
Dim str() As String
Dim i As Long, dlr As Long
Dim dtStr As String


Application.ScreenUpdating = False


Set ws = Sheets("Sheet1")
ws.Range("A1").CurrentRegion.Offset(1).Clear


Set olApp = New Outlook.Application




Set NS = olApp.GetNamespace("MAPI")
Set oFolder = NS.GetDefaultFolder(olFolderInbox)




Set Items = oFolder.Items


For Each Item In Items
If TypeOf Item Is Outlook.MailItem Then
If Item.Subject = "Opportunity Approved*" Then



dlr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
BodyTxt = Split(Item.Body, vbCrLf)
For i = LBound(BodyTxt) To UBound(BodyTxt)
If InStr(BodyTxt(i), ":") > 0 Then
str = Split(BodyTxt(i), ":")
If InStr(str(0), "Deal ID:") > 0 Then
ws.Range("A" & dlr).Value = str(1)
ElseIf InStr(str(0), "Opportunity Name:") > 0 Then
ws.Range("B" & dlr).Value = str(1)
ElseIf InStr(str(0), "Rejection Reason:") > 0 Then
ws.Range("C" & dlr).Value = str(1)
ElseIf InStr(str(0), "Partner Account Name:") > 0 Then
ws.Range("D" & dlr).Value = str(1)
End If
End If
Next i


End If
End If

Next Item


Set olApp = Nothing
Application.ScreenUpdating = True
MsgBox "Task Completed Successfully.", vbInformation
End Sub

We seem to have moved from items that were not approved to those that were.
The following function looks for the texts you have described in your last message.
It looks for the presence of the first text and then if that exists looks for the second and extracts the ID from it.

Code:

---

Private Function GetData(olItem As Object) As String
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim strData As String
    On Error Resume Next
    With olItem
        If InStr(1, olItem.Body, "The following deal has been approved and associated to one of your accounts: ") > 0 Then
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(findText:="Deal ID: *>", MatchWildcards:=True)
                    strData = oRng.Text
                    strData = Trim(Replace(strData, "Deal ID:", ""))
                    'do something with strdata e.g.
                    GetData = strData
                    Exit Do
                Loop
            End With
        End If
    End With
lbl_Exit:
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olItem = Nothing
    Exit Function
End Function

---

***Sorry - only pay attention to the first image with all 4 columns****

Hi Graham!

Yes - almost there! When i run the above code, i see it pulls the data to the immediate screen in the Visual Basic Editor, but how do i get it to open an excel sheet, and place the data in a worksheet? Am i needing to create an excel sheet first and run the macro from the Excel sheet?

I have two types of emails with two subject lines i am looking for only - i will list them below:

1) The following deal has been approved and associated to one of your accounts:
==> From this email, i would need 4 things from the body pulled (Deal ID: / Opportunity Name: / Partner Account Name: / Solution Type: )

and the second one:

2) We are unable to approve your deal registration request for the following reason:
===> From this email, i would need (Deal ID: / Opportunity Name: / Partner Account Name: / Rejection Reason: )

i would need two pieces of data pulled from the body of the email as opposed to one. Not only do i need the subject "We are unable to approve your deal registration request for the following reason:", but then i need from the body "Deal ID:" and "Rejection Reason:"


To keep it easy, i will create a macro for each one.

If it helps, below is a screen shot of where i am wanting the data to be place in excel:



Attachment 23763


This should just about do it - I really appreciate your help on this.

You have moved the goal posts yet again:banghead:.

This forum is not a free code writing service. The code does not address writing to Excel and merely points the way to extract data from an Outlook message. You will undoubtedly need to modify the code to suit your requirements.

What you do with that data is a matter for you and writing data to Excel has been well covered in this and other forums. See also
See http://www.gmayor.com/extract_data_from_email.htm which shows examples of how to do that.

Hi Graham - my apologies. I only discovered VBA 2 weeks ago so i am very new. As i am learning more, I am adding more information on. It was never my intent to confuse or abuse this forum. I really appreciate all you have done for me so far and i should be able to figure out what to do from here.

Have a great day!