Find Original emails - Not the FW/RE & Pull certain data from the Body

[Kreiz]

Hello,

Have a macro to pull all of the emails that contain "Tender -" in the subject, into excel as I am needing to extract specific data from the table in the email body.

The macro pulls all emails in the specified folder that container replies, and forwards, as well as the tender changes,

Column B
Tender - WMS - HOWELL, MI - 08/27 12:00
RE: CHANGE - WMS - HOWELL, MI - 08/29 16:00
RE: CHANGE - FCL - MISSOULA, MT - 09/05 16:00
RE: CHANGE - JKSV - CHARLESTON, SC - 08/30 16:00
Tender - FCL - ORLANDO, FL - 08/29 12:00
RE: Tender - WMS - HOWELL, MI - 08/27 12:00
***NEW LOAD Tender - FCL - ORLANDO, FL - 08/29 12:00
RE:  Tender - WMS - HOWELL, MI - 08/27 12:00
Tender - FCL - DICKINSON, ND - 08/28 09:00
FW: Load Tender issued (11915004)
FW: Load Tender issued (11914960)

I am looking for a way to only get the original emails, not the RE; & ***NEW LOAD, & FW:'s

Here is the code I;ve been working with.

Sub GetFromInbox()

    Dim olApp As Outlook.Application
    Dim olNs As Namespace
    Dim Fldr As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer
    Cells.Select
Selection.Delete
lastrow = ActiveSheet.UsedRange.Rows.Count
i = lastrow + 1

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("CUSTOMER1 FOLDER")
    

    For Each olMail In Fldr.Items
        If InStr(olMail.Subject, "tender -") > 0 And InStr(olMail.Sender, "CUSTOMER1 EMAIL") > 0 Or _
        InStr(olMail.Body, "tender") > 0 Then
            
            ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime
            ActiveSheet.Cells(i, 2).Value = olMail.Subject
            ActiveSheet.Cells(i, 3).Value = olMail.Sender
            ActiveSheet.Cells(i, 4).Value = olMail.UnRead
            ActiveSheet.Cells(i, 5).Value = olMail.Body
            i = i + 1
            
        End If
    Next olMail
 
    'Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("CUSTOMER2 FOLDER")
    

    For Each olMail In Fldr.Items
        If InStr(olMail.Body, "" & "Load Tender issued") > 0 Then
        'Or _
            'InStr(olMail.Subject, "*" & "Load Tender issued") > 0
                        
            ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime
            ActiveSheet.Cells(i, 2).Value = olMail.Subject
            i = i + 1
            
        End If
    Next olMail
    Cells.Select
Selection.WrapText = False

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

As well, my body is pasted in column 5, One of my customers uses a table in the email that has data I need to extract a specific line of data from the table, this line comes to look like: N/A216547330016547330DRYNNN in excel, which is the row below the following questions in the original email:
Trip Number | Number of Stops | Shipment ID | Pymt Ref. # | Equipment |Same Day | Chilled | Non-Al |

This is the extract from part of the table in my email:

Trip Number Number of Stops Shipment ID Pymt Ref. # Equipment Same Day Beer Draught Non-Alcohol
N/A 2 16547330 016547330 DRY N N N

Any ideas on how i can take the cell with the entire body and only extract a part of the table?

 

[Kreiz]

Here is one of the email bodies:
I am looking to extract and split the line,
N/A 2 16000000 016000000 DRY N Y N

ORIGINAL LOAD TENDER
Carrier:Vertex Transport, Llc
Response Time Required By:08/25/2011 10:22:00 * CENTRAL TIME
Tender Instructions:
Respond to this Load Tender by Date and Time specified above or Tender will be considered declined .
Non-refrigerated cold loads must be delivered within 14 hours of load time .
Refrigerated draught loads should be maintained at 38 degrees Fahrenheit until delivery .
Maintain drop trailer pools, please no bob tailing into the brewery .
All dropped trailers must have tandems slid to the rearmost position and locked .
Call your CUSTOMER for any questions you have about this tender .
Stop Number Stop Type Commodity Gate Check-In #
1 PICKUP DRINK 16530492
Account #: JKSV
Location Name: BRWY-- Jacksonville
Address: 111 STREET DRIVE
JACKSONVILLE , FL * 32208
Phone: 000-000-000
Fax: 999-999-9999

PULL DATE/TIME
08/29/2011 03:00:00 EASTERN TIME

Trip Number Number of Stops Shipment ID Pymt Ref. # Equipment Same Day Beer Draught Non-Alcohol
N/A 2 16000000 016000000 DRY N Y N
Stop Number Stop Type Commodity Gate Check-In #
2 DELIVERY BEER 00000000
Account #: 00000
Location Name: WSLR-- THESE PEOPLE Inc
Address: 160 CHARLESTON SOMETHING PKWY.
CHARLESTON , SC * 29402
Phone: 990-000-6800
Fax: 843-388-6796

Expected DELIVERY DATE
08/29/2011

Memo:
Stop 2 Memo: OVER THE ROAD RECEIVING HOURS M-F 07:00-14:00/SAT 9:00-13:00CALL WAREHOUSE 000-000-1022
PO Number:
Y "

 

[Kreiz]

I found a crude way to get the information using the Mid function, just dont know how to use VBA to get these into a cell instead of entering these into the workwsheet manually after the macro places in the email data into the sheet


=MID($E2,FIND("N/A",$E2)+6,8) & =MID(E2,FIND("N/A",E2)+25,3)
into column G and H