Mondays Mission: Macro to extract text from an email and paste it into an EXCEL Sheet

[maxwello]

Good Morning All,
I don’t know if this is possible but have hundreds of emails that I need to collect the data that is held in the body of the email. All the emails have the same text layout and the fields that I want to extract have the same headings. (See below example)

I would really appreciate any assistance or advice that you are able to provide.

Dear Sir,
Please find my account setup below.</SPAN>

User Name:Joe Blogs</SPAN>
User Firm:Blogs Inc</SPAN>
Email address: Joe.blogs@blogsinc.co.uk</SPAN>
Country:ENGLAND</SPAN>
UUID:1111111</SPAN>
User #:123456</SPAN>
Cust #:123456</SPAN>
Firm #:123456</SPAN>
Serial #:123456</SPAN>
Broker:ABAX</SPAN>
Application:Windows</SPAN>

 

[Comfy]

What application are you using for your emails, Outlook?

And will all the emails be in the same folder? If so, what is the folder name?

 

[maxwello]

Hi Comfy,

The emails will all be in a folder called 1Europe within Outlook directly under the mailbox.

Mailbox - joeblogs
+1Europe

 

[Comfy]

I've amended some code that I use to extract payroll numbers from emails.

You will need to add the following references:

-Microsoft Outlook Object Library
-Microsoft VBScript Regular Expressions

Sub EmailExtract()
Dim re As Object
Dim matches As MatchCollection
Dim match As match
Dim OutApp As New Outlook.Application
Dim oMAPI As Outlook.Namespace
Dim oParentFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.Folder
Dim oMail As Outlook.MailItem
Dim Headers(1 To 11) As String
Dim i As Long, j As Long, k As Long
Dim temp As String


Headers(1) = "User Name:"
Headers(2) = "User Firm:"
Headers(3) = "Email address:"
Headers(4) = "Country:"
Headers(5) = "UUID:"
Headers(6) = "User #:"
Headers(7) = "Cust #:"
Headers(8) = "Firm #:"
Headers(9) = "Serial #:"
Headers(10) = "Broker:"
Headers(11) = "Application:"


Set OutApp = New Outlook.Application
Set oMAPI = OutApp.GetNamespace("MAPI")
Set oParentFolder = oMAPI.Folders("Mailbox - joeblogs")
Set oFolder = oParentFolder.Folders("1Europe")
i = 2


Set re = CreateObject("VBScript.RegExp")


With re
    .IgnoreCase = True
    .MultiLine = True
End With






For Each oMail In oFolder.Items
    For j = LBound(Headers) To UBound(Headers)
        re.Pattern = Headers(j) & "[\S\s]+?$"
        
        Set matches = re.Execute(oMail.Body)
        Select Case matches.Count
            Case Is > 1
                For k = 1 To matches.Count
                    temp = Replace(matches(k - 1) & ";", Headers(j), "")
                Next k
                Cells(i, j).Value = temp
                temp = ""
            Case 1
                Cells(i, j).Value = Replace(matches(0), Headers(j), "")
            Case Else
                Cells(i, j).Value = "No Match"
            End Select
    Next j
i = i + 1
Next oMail


End Sub

The workbook that is to contain the output should already have the headers listed:

Excel 2010

	A	B	C	D	E	F	G	H	I	J	K
1	User Name	User Firm	Email Address	County	UUID	User #	Cust #	Firm #	Serial #	Broker	Application
2	Joe Blogs	Blogs Inc	HYPERLINK "mailto:Joe.blogs@blogsinc.co.uk"Joe.blogs@blogsinc.co.uk	ENGLAND	1111111	123456	123456	123456	123456	ABAX	Windows
3	Joe Blogs	Blogs Inc	HYPERLINK "mailto:Joe.blogs@blogsinc.co.uk"Joe.blogs@blogsinc.co.uk	ENGLAND	1111111	123456	123456	123456	123456	ABAX	Windows

<tbody>
</tbody>

Sheet1​

For testing I added two mail items to the folder. Hence the outout.

Edit - Although the Regular Expression does not work for finding multiple items. Is it likely that you would get duplicates in an email?

 

[maxwello]

Comfy, you are a legend.

Thank you so much.

 

[Comfy]

Comfy, you are a legend.

Thank you so much.

No worries.

Just so you know this part doesn't work:

Case Is > 1
                For k = 1 To matches.Count
                    temp = Replace(matches(k - 1) & ";", Headers(j), "")
                Next k
                Cells(i, j).Value = temp
                temp = ""

You can just delete it or I can take a look at this section again if you think there is a chance that you would have duplicate headers in the email?

 

[maxwello]

Hi Comfy,
No there will never be duplicate headers so I think we are all good. Next step is I need working out how to package the data depending on the user name and send an email with the consolidated data.

But thanks you very much for your help on the first step.

Regards
Oliver

 

[Comfy]

Next step is I need working out how to package the data depending on the user name and send an email with the consolidated data.

Just post some examples here if you want some help with this too.

 

[maxwello]

Comfy,
I am going to have to take you up on your offer of more help.

So the first part of the Macro is working like a dream, what I now have is a pivot table of my data and several different clients and I want to email the clients informaiton to someone showing what is populated in the pivot table. Ideally I would like to do this automatically so for every client the marco will open up an email template and paste in the relevant section of the pivot table along with the headings and it would be even better if it could add the cleints name taht is in the pivot table.


Example Pivot table:

User Firm	SDS	Approved (Y/N)	Salesperson	User Name	UUID	Product Setup	Email Text
Joe Blogs Inc	(blank)	(blank)	Adam	Adam1	9325071	Apples
						Oranges
						Pear
						PineApple
						Kiwi
						Banana
Joe Blogs Inc Total
John Smith Inc	(blank)	(blank)	Bob	Bob2	10059805	Kiwi
John Smith Inc Total

<COLGROUP><COL style="WIDTH: 75pt; mso-width-source: userset; mso-width-alt: 3657" width=100><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 59pt; mso-width-source: userset; mso-width-alt: 2889" width=79><COL style="WIDTH: 48pt" span=3 width=64><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3620" width=99><TBODY>
</TBODY>

Email 1:

Subject: Joe Blogs - Enablement Request

Dear Sir,
Please can you provide sign-off for the below

User Firm	SDS	Approved (Y/N)	Salesperson	User Name	UUID	Product Setup	Email Text
Joe Blogs Inc	(blank)	(blank)	Adam	Adam1	9325071	Apples
						Oranges
						Pear
						PineApple
						Kiwi
						Banana
Joe Blogs Inc Total

<COLGROUP><COL style="WIDTH: 75pt; mso-width-source: userset; mso-width-alt: 3657" width=100><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 59pt; mso-width-source: userset; mso-width-alt: 2889" width=79><COL style="WIDTH: 48pt" span=3 width=64><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3620" width=99><TBODY>
</TBODY>

Email 2:

Subject: John Smith - Enablement Request



Dear Sir,
Please can you provide sign-off for the below

User Firm	SDS	Approved (Y/N)	Salesperson	User Name	UUID	Product Setup	Email Text
John Smith Inc	(blank)	(blank)	Bob	Bob2	10059805	Kiwi
John Smith Inc Total

<COLGROUP><COL style="WIDTH: 75pt; mso-width-source: userset; mso-width-alt: 3657" width=100><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 59pt; mso-width-source: userset; mso-width-alt: 2889" width=79><COL style="WIDTH: 48pt" span=3 width=64><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3620" width=99><TBODY>
</TBODY>

 

[Comfy]

Sure I'll take a look.

I suck at Pivot Tables though so could you let me know how you have your fields setup so that I can recreate yours?