Get Data in Email Body amending exisiting VBA code

S

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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

H
  • Question
Outlook VBA Search Slowness
Replies
1
Views
1K
bobsan42
bobsan42
N
  • Question
How to link to subfolder with current VBA Macro
Replies
0
Views
831
NikkiC78
N
L
  • Question
VBA Email extract problem
Replies
0
Views
379
Liverlee
L
H
  • Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
175
harmless92
H
M
  • Question
Code to create email with screenshot below email body
Replies
7
Views
717
Micron
M

Forum statistics

Threads
1,215,248
Messages
6,123,877
Members
449,130
Latest member
lolasmith

Share this page

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