Pull Specific Data from Email Body/none constant variable

[jrobertson83]

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.

[gmayor]

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


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

[jrobertson83]

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.

[gmayor]

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


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

[jrobertson83]

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.
23751
Again, i really appreciate you taking the time to help me on this.

[jrobertson83]

(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

[gmayor]

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.


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

[jrobertson83]

***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:



23763


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

[gmayor]

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 (http://www.gmayor.com/extract_data_from_email.htm) which shows examples of how to do that.

[jrobertson83]

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!