Get Data in Email Body amending exisiting VBA code

Shak1980

New Member
Joined
Aug 5, 2014
Messages
19
Hi all

I was wondering if I could get some help with this. I have the existing code below in excel, which allows me to transfer information from the subject line into excel. However, I would also like to pull info from the boy of the email. I want to either extract specific data or the fullinformation from the email body and put it in column 9 of the worksheet. I want to amend my current to accomidate this.

Really stuck on this one, so any help would be appreciated.

Thank you in advance.

Code:
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][INDENT][FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]1.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]Worksheets("EmailCheck").Activate[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]2.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]3.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Dim Folder As Outlook.MAPIFolder[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]4.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Dim sFolders As Outlook.MAPIFolder[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]5.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Dim iRow As Integer, oRow As Integer[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]6.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Dim MailBoxName As String, Pst_Folder_Name  As String[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]7.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Dim sSubject As String[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]8.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]9.  [/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    MailBoxName = "Compliance"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]10.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]11.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]12.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Pst_Folder_Name = "Inbox"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]13.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]14.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    For Each Folder InOutlook.Session.Folders(MailBoxName).Folders[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]15.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        If VBA.UCase(Folder.Name) =VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]16.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        For Each sFolders In Folder.Folders[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]17.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]            If VBA.UCase(sFolders.Name) =VBA.UCase(Pst_Folder_Name) Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]18.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]                Set Folder = sFolders[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]19.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]                GoTo Label_Folder_Found[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]20.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]            End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]21.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        Next sFolders[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]22.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Next Folder[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]23.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]24.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]Label_Folder_Found:[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]25.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]     If Folder.Name = "" Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]26.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        MsgBox "Invalid Data inInput"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]27.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        GoTo End_Lbl1:[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]28.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]29.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]30.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]31.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    ThisWorkbook.Sheets(1).Activate[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]32.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Folder.Items.Sort "Received"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]33.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]34.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    ThisWorkbook.Sheets(1).Cells(1, 7) ="Subject"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]35.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    ThisWorkbook.Sheets(1).Cells(1, 8) ="Date"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]36.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]37.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    oRow = 1[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]38.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    For iRow = 1 To Folder.Items.Count[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]39.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]40.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        If VBA.DateValue(VBA.Now) -VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]41.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]42.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]            sSubject =Folder.Items.Item(iRow).Subject[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]43.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]            If UCase(sSubject) Like "*FSFUPDATE  FOR*" Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]44.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]45.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]               oRow = oRow + 1[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]46.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]              ThisWorkbook.Sheets(1).Cells(oRow, 1).Select[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]47.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]               ThisWorkbook.Sheets(1).Cells(oRow,7) = Folder.Items.Item(iRow).Subject[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]48.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]              ThisWorkbook.Sheets(1).Cells(oRow, 8) =Folder.Items.Item(iRow).ReceivedTime[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]49.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]50.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]            End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]51.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]52.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]        End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]53.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Next iRow[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]54.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    MsgBox "Outlook Mails Extracted toExcel - Please ensure that all extracted emails are transferred from the'Inbox' into 'Processed KYC Update Emails' folder"[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]55.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Set Folder = Nothing[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]56.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    Set sFolders = Nothing[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]57.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]    [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]58.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]End_Lbl1:[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]59.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]60.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"]Worksheets("EmailCheck").Activate[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]61.[/FONT][/COLOR][COLOR=#3E3E3E][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][/INDENT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#3E3E3E][FONT="Courier New"]UserForm1.Hide[/FONT][/COLOR]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,223,275
Messages
6,171,123
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top