Extract Email Body Info using Excel VBA

[ShakJames]

Hi all

I was wondering if I could get some help with this. I use the following code to extract information from the subject line from an email. However, I also want to pull some information from the body of the same email. I want to either extract specific data or the full information from the email body and put it in column 9 of the worksheet.

Can anyone help me amend the following code to do this?

Any help would be greatly appreciated. Thank you in advance.

Worksheets("Email Check").Activate

    Dim Folder As Outlook.MAPIFolder
    Dim sFolders As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String
    Dim sSubject As String

    MailBoxName = "Compliance"
 

    Pst_Folder_Name = "Inbox"

    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder
 
Label_Folder_Found:
     If Folder.Name = "" Then
        MsgBox "Invalid Data in Input"
        GoTo End_Lbl1:
    End If
 

    ThisWorkbook.Sheets(1).Activate
    Folder.Items.Sort "Received"
    
    ThisWorkbook.Sheets(1).Cells(1, 7) = "Subject"
    ThisWorkbook.Sheets(1).Cells(1, 8) = "Date"

    oRow = 1
    For iRow = 1 To Folder.Items.Count

        If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then

            sSubject = Folder.Items.Item(iRow).Subject
            If UCase(sSubject) Like "*FSF UPDATE  FOR*" Then

               oRow = oRow + 1
               ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
               ThisWorkbook.Sheets(1).Cells(oRow, 7) = Folder.Items.Item(iRow).Subject
               ThisWorkbook.Sheets(1).Cells(oRow, 8) = Folder.Items.Item(iRow).ReceivedTime

            End If

        End If
    Next iRow
    MsgBox "Outlook Mails Extracted to Excel - Please ensure that all extracted emails are transferred from the 'Inbox' into 'Processed KYC Update Emails' folder"
    Set Folder = Nothing
    Set sFolders = Nothing
    
End_Lbl1:

Worksheets("Email Check").Activate

UserForm1.Hide

[Richard Buttrey]

Is this not essentially an Outlook programming question?

If so I'll move it to the dedicated Outlook sub forum.

[ShakJames]

Hello

Would it not stay in here because I am the coding is in Excel and not Outlook?

[Richard Buttrey]

I understood the request was to get information from an Outlook email for Excel.

Getting information is usually the hardest part, putting it somewhere is trivial. It therefore seemed more logical that the essential coding would involve VBA for Outlook rather than VBA for Excel, although of course I accept the result ends up in Excel.

Your choice really - it just seemed to me that those members who know more about Outlook VBA would be reached more easily if it was in a dedicated Outlook forum