VBA to pull information email table

[DEllis]

Hello everyone, I need a macro that will go into a folder called "Bulk" and pull the email information like sender, date, subject and the body. The email itself also has a table in it and I need to extract the email that is in the table and the name as well.

Is this something that is possible?

Just can't seem to understand how to do this.

thank you in advance for any help received.
DEllis

 

[Rijnsent]

Hi DEllis,
yes, something like that is probably possible using VBA/macros. See e.g. this post to loop though a mailbox: Looping through outlooks inbox You'll probably need to do a bit more coding, but if it's a task you have to do often it's probably worth to automate.
Cheers,
Koen

 

[DEllis]

Thank you, not exactly what I am looking for but a good start. What I want to do is get emails from outlook into excel to load into another system. And I had a VBA that worked but a new formatted email has come in with a table which has the information I need so now the VBA will not pull what is in the email table into excel for me.

Appreciate the help.
DEllis

 

[Rijnsent]

Yeah, so your steps would be:

• loop through all emails of the Bulk folder (it looks like you have set this up?)
• per email, check for contents of the email. You can find the table probably if you search through the .Body or the .HTMLBody of the email. This code does something in that direction:
  
  

  Excel Vba Extract Table from Outlook message body if string exists in subject

  I have the following code for extracting tables from Outlook email. However it only looks at the latest email. I need it to be able match string in the subject of the email in order to identify which email to extract the table from. Can someone please let me know what I need to add to the code...

  www.mrexcel.com
• take the info you need from the table and write it to your Excel.

If you have code to share so people here can give feedback, please do so.
Koen

 

[DEllis]

Here is the code I have which now won't pull but one email at a time

Sub eaddrtosuppr()
On Error GoTo ErrHandler
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

Dim objNSpace As Object
Set objNSpace = objOutlook.GetNamespace("MAPI")


Dim oAccount As Account
Dim item As Object
Dim procfolder As Folder
Dim iRows, iCols, i As Integer
Dim rng As Range
Dim lastrow As Long
Dim NArray, firstname, lastname As String
Dim wb As Workbook
Dim ws As Worksheet
Dim Rdate As Date

Set wb = ActiveWorkbook
Set ws = wb.Sheets("Friday")
Sheets("Friday").UsedRange.Clear
'Set rng = ActiveSheet.UsedRange
' Set rng = ws.UsedRange
'lastrow = rng.Rows(ActiveSheet.UsedRange.Rows.Count).Row


'lastrow = ActiveSheet.ListObjects("Unsubs").Range.Rows.Count
'iRows = lastrow + 1
iRows = 2

Set procfolder = objNSpace.Folders("Main").Folders("Inbox").Folders("Requests")
For Each item In procfolder.Items

Cells(iRows, 1) = item.SenderEmailAddress 'Email Address from email request
Cells(iRows, 5) = "End User" 'type of customer
Cells(iRows, 6) = "Email" 'Channel that request came in by
Cells(iRows, 7) = "Customer Support" ' Business function from record of truth
Cells(iRows, 8) = "Type" ' Type of Request
' Cells(iRows, 9) = "Request - " ' Add name of person called after pull
Cells(iRows, 10) = item.ReceivedTime 'date and time email request was received
Cells(iRows, 11) = item.Subject & vbCrLf & item.Body 'email subject and body test to be used as long description in record of truth
Cells(iRows, 12) = "Out" 'Marketing
Cells(iRows, 13) = "Out" 'Target
Cells(iRows, 14) = "" 'Service ? to be provided by MKTing
Cells(iRows, 15) = "" 'Suppress all? to be provided by MKTing
Cells(iRows, 16) = "Yes" '? to be provided by MKTing
Cells(iRows, 17) = "" 'Stop ? to be provided by MKTing
Cells(iRows, 18) = "" 'X Account? to be provided by CS
Cells(iRows, 19) = "" 'Z Account? to be provided by CS
Cells(iRows, 20) = "" 'Country to be provided by CS
Cells(iRows, 21) = "" 'State if Yes to Country
Cells(iRows, 22) = "" 'Device Linked? to be provided by CS
Cells(iRows, 23) = "" 'Device type? to be provided by CS
Cells(iRows, 24) = "" 'Delete? to be provided by CS
Cells(iRows, 25) = "" 'Comments provided by MKTing & CS
Cells(iRows, 27) = "Request - Customer - Case Management"

'H206+7-WEEKDAY(H206+1)
Rdate = item.ReceivedTime + 8 - Weekday(item.ReceivedTime, vbFriday)
Cells(iRows, 26) = Rdate 'Date resolved

i = iRows

GetName (item.Body) 'Passing email body to below function and then extracts name returning value back to top function
Cells(iRows, 2) = NM
NArray = Split(NM, " ", 2)
Cells(iRows, 3) = NArray(0)
Cells(iRows, 4) = NArray(1)
Cells(iRows, 9) = "Request - " & NM ' Add name of person
iRows = iRows + 1

Next

ErrHandler:
Debug.Print Err.Description
End Sub
____________________________________________

Private Function GetName(EmailBody As String) As String
Dim Ar As Variant
Dim i As Long
Dim L As Integer
' Dim NM As String


'~~> Split the body text into an array
'~~> If vbNewLine doesn't work then try vbCrLf or vbLf
Ar = Split(EmailBody, vbNewLine)

'~~> Loop through the array and find the line which has "My name is"
For i = LBound(Ar) To UBound(Ar)
If InStr(1, Ar(i), "My name is ", vbTextCompare) Then
'~~> Extract name
NM = Split(Ar(i), "My name is ")(1)
L = Len(NM) - 1
NM = Left(NM, L)

' MsgBox (NM)



Exit For

____________________________________
New email is now coming in with a table that I need to extract the name and email out of along with other alternative emails if they exist.