how we can export a specific data from outlook body message to excel .
on 2 model of mail
and how we can count number of lines on mail body.
a give you my example .
mail type1 one is
[First Name],Boby Rayan
[Cont Number], A0ED011011782
[Send Date],03/03/18
[Total Mt],00742241
[Total Mtc],00209166
[Total Mtb],00533075
[Total Mtfs],00101361
mail type2 one is
[First Name],David porter
[Cont Number], A1UF011011598
[Send Date],03/01/18
[Total Mtb],00258552
[Total Mtfs],00146186
and i receive mail type and 2 in same inbox mail
what i need in excel is like this
First Name * Cont Number * Send Date* Total Mt * Total Mtc * Total Mtb * Total Mtfs
Boby Rayan * A0ED011011782 * 03/03/18 * 00742241 * 00209166 *00533075 * 00101361
David porter*A1UF011011598 * 03/01/18 * * * 00258552 * 00101361
What I have tried:
i tried this if some one can help me
Sub Extract()
On Error Resume Next
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim x As Long
Dim arrHeaders As Variant
Set xlobj = CreateObject("excel.application.15")
xlobj.Visible = True
xlobj.Workbooks.Add
xlobj.Worksheets("Sheet1").Name = "Statusmail"
xlobj.Range("a" & 1).Value = "Sender"
xlobj.Range("a" & 1).Font.Bold = "True"
xlobj.Range("c" & 1).Value = "First Name"
xlobj.Range("c" & 1).Font.Bold = True
xlobj.Range("d" & 1).Value = "Cont Number"
xlobj.Range("d" & 1).Font.Bold = True
xlobj.Range("e" & 1).Value = "Send Date"
xlobj.Range("e" & 1).Font.Bold = True
xlobj.Range("f" & 1).Value = "Total Mt"
xlobj.Range("f" & 1).Font.Bold = True
xlobj.Range("g" & 1).Value = "Total Mtc"
xlobj.Range("g" & 1).Font.Bold = True
xlobj.Range("h" & 1).Value = "Total Mtb"
xlobj.Range("h" & 1).Font.Bold = True
xlobj.Range("i" & 1).Value = "Total Mtfs"
xlobj.Range("i" & 1).Font.Bold = True
For x = 1 To myfolder.Items.Count
Set myitem = myfolder.Items(x)
msgtext = myitem.Body
delimtedMessage = Replace(msgtext, "[First Name],", "###")
delimtedMessage = Replace(delimtedMessage, "[Cont Number],", "###")
delimtedMessage = Replace(delimtedMessage, "[Send Date],", "###")
delimtedMessage = Replace(delimtedMessage, "[Total Mt],", "###")
delimtedMessage = Replace(delimtedMessage, "[Total Mtc],", "###")
delimtedMessage = Replace(delimtedMessage, "[Total Mtb],", "###")
delimtedMessage = Replace(delimtedMessage, "[Total Mtfs],", "###")
messageArray = Split(delimtedMessage, "###")
xlobj.Range("a" & x + 1).Value = myitem.To
xlobj.Range("b" & x + 1).Value = messageArray(0)
xlobj.Range("c" & x + 1).Value = messageArray(1)
xlobj.Range("d" & x + 1).Value = messageArray(2)
xlobj.Range("e" & x + 1).Value = messageArray(3)
xlobj.Range("f" & x + 1).Value = messageArray(4)
xlobj.Range("g" & x + 1).Value = messageArray(5)
xlobj.Range("h" & x + 1).Value = messageArray(6)
xlobj.Range("i" & x + 1).Value = messageArray(7)
Next
End
End Sub