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

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

H
  • Question Question
Outlook VBA Search Slowness
Replies
1
Views
1K
bobsan42
bobsan42
N
  • Question Question
How to link to subfolder with current VBA Macro
Replies
0
Views
980
NikkiC78
N
L
  • Question Question
VBA Email extract problem
Replies
0
Views
669
Liverlee
L
H
  • Question Question
VBA split file based and send splitted file in separate emails
Replies
0
Views
735
harmless92
H
C
  • Question Question
Create code that sends emails and creates a log
Replies
1
Views
315
cokeoverpepsi123
C

Forum statistics

Threads
1,224,828
Messages
6,181,213
Members
453,024
Latest member
Wingit77

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