Solved

Parse Outlook message body to Excel File

Posted on 2014-03-28
8
1,075 Views
Last Modified: 2014-04-09
Hi I have an email that comes into my inbox every couple of minutes.  I want to strip the message body text and put it in ROW format in an Excel/CVS file.  The tricky part is that i want to pull in everything to the Right of the =(equal) sign.  The format of the body is below and as you can see it is Horizontal.  I need to get it Vertical and each item in a cell.  Help Please!

HireDate = Fri Mar 28 14:30:50 2014
HireMgr = Me
HireRpt = You
Pager_Number = 123-11-1234
comment=Both_Qualify
id_counter=1
employee1_firstname=me
employee1_middlename=me
employee1_lastname=m3
employee1_ssn=---------
employee1_ssn_counter=1
employee1_dob=12/06/1900
employee1_addr=123 main street
employee1_addr_counter=10
employee1_apt=2
employee1_city=miami
employee1_state=fl
employee1_zip=33150
employee1_idtype=dl
employee1_idnum=6
employee1_idnum_counter=1
employee1_email=something@122
employee1_email_counter=1
employee1_priphone=123-123-1234
employee1_phone_counter=3
employee1_action=NA
employee2_firstname=you
employee2_middlename=y
employee2_lastname=your
employee2_ssn=---------
employee2_dob=09/24/1900
employee2_addr=123 main street
employee2_apt=NA
employee2_city=miami
employee2_state=fl
employee2_zip=33150
employee2_idtype=dl
employee2_idnum=123
employee2_email=pb@pb
employee2_priphone=123-12-1234
employee2_action=NA
Work_City=Fort Lauderdale
Work_Region=FL
Work_Country=United States
Work_Country_code=US
0
Comment
Question by:farmingtonis
  • 3
  • 3
  • 2
8 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 39962013
HTML or Plain Text body?
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39962035
This will add the values as a csv string at the top of the email you run it on:
Sub farmingtonisSplit()
    Dim vText As String, olItem As Outlook.MailItem, vLines As Variant
    Set olItem = ActiveExplorer.Selection.Item(1)
    vText = olItem.Body
    vLines = Split(vText, vbCrLf)
    For i = LBound(vLines) To UBound(vLines)
     If vLines(i) Like "*=*" Then
      vText = Mid(vLines(i), InStr(1, vLines(i), "=") + 1)
      vLines(i) = Trim(vText)
     End If
    Next
    olItem.Body = Join(vLines, ",") & vbCrLf & vbCrLf & olItem.Body
End Sub

Open in new window

We can adapt it to send it to excel pretty easily, but you'll have to explain where you want it, etc.

Matt
0
 
LVL 39

Expert Comment

by:nutsch
ID: 39962048
This code might work for you if you run it after selecting the email. It will put the values in columns in a new excel worksheet.

Sub ProcessReceivedInvoice()
Dim xlApp As Excel.Application, sBody As String, xlWbk As Excel.Workbook
Dim mySelectedItem As MailItem, arrBody, lLoop As Long

Set mySelectedItem = miFnGetSelectedItem

sBody = mySelectedItem.Body

Set xlApp = xlappFnGetExcel
Set xlWbk = xlApp.Workbooks.Add

arrBody = Split(sBody, vbCrLf)

xlApp.ScreenUpdating = False

For lLoop = LBound(arrBody) To UBound(arrBody)
    xlWbk.Sheets(1).Cells(1, lLoop + 1).value = Mid(arrBody(lLoop), InStr(arrBody(lLoop), "=") + 1)

Next

xlApp.ScreenUpdating = True

End Sub

Function miFnGetSelectedItem() As MailItem

    Dim MyOlApplication As Outlook.Application
    Dim MyOlNameSpace As NameSpace
    Dim myOlSelection
    
     Set MyOlApplication = CreateObject("Outlook.Application")
     Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
     Set myOlSelection = MyOlApplication.ActiveExplorer.Selection
     
     If myOlSelection.Count = 0 Then
        Msgbox "Please select an item first", vbExclamation
        Exit Function
     End If
     
     If myOlSelection.Count > 1 Then
        Msgbox "Please select only one item", vbExclamation
        Exit Function
     End If
     
     Set miFnGetSelectedItem = myOlSelection.Item(1)
    
    
     'Cleanup
     Set MyOlApplication = Nothing
     Set MyOlNameSpace = Nothing
     Set myOlSelection = Nothing
    

End Function


Public Function xlappFnGetExcel()
Dim xlApp As Excel.Application

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Not xlApp.Visible Then xlApp.Visible = True
On Error GoTo 0

If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True
End If

Set xlappFnGetExcel = xlApp

End Function

Open in new window

0
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
ID: 39962055
Similar to my first one, this will add an attachment to the sheet you run it on with the lines split into one row:
Sub farmingtonisSplit()
    Dim vText As String, olItem As Outlook.MailItem, vLines As Variant
    Set olItem = ActiveExplorer.Selection.Item(1)
    vText = olItem.Body
    vLines = Split(vText, vbCrLf)
    For i = LBound(vLines) To UBound(vLines)
     If vLines(i) Like "*=*" Then
      vText = Mid(vLines(i), InStr(1, vLines(i), "=") + 1)
      vLines(i) = Trim(vText)
     End If
    Next
   
    Dim xlApp As Object, xlBook As Object, xlSheet As Object
    Set xlApp = CreateObject("excel.application")
    Set xlBook = xlApp.Workbooks.Add(1)
    xlBook.ActiveSheet.Range("A1").Resize(1, UBound(vLines) + LBound(vLines) - 1).Value = vLines
    vText = Environ("temp") & "\" & CStr(CLng(Rnd() * 89999999) + 10000000) & ".xlsx"
    xlBook.SaveAs vText
    xlBook.Close False
    xlApp.Quit
    Set xlApp = Nothing
    olItem.Attachments.Add vText
    olItem.Save
    Kill vText
End Sub

Open in new window

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:farmingtonis
ID: 39962230
I think my post was a little confusing.  I need the tool to go through every email in a specific email box and then write the contents to an existing .csv file.  I don't need them emailed or attached to an email.  Something like this:

Sub GetInbox()
    Dim olApp, olNamespace, olInbox, olItem
    Dim strFileName As String, objFS, objTS
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(6).Folders("0_Kevin")
 
 
    strFileName = "C:\test1.csv"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set objTS = objFS.getfile(strFileName)
    If Err.Number <> 0 Then objFS.CreateTextFile strFileName
    On Error GoTo 0
    Set objTS = objFS.OpenTextFile(strFileName, 8)
 
    On Error Resume Next
    For Each olItem In olInbox.Items
        objTS.Write olItem.SenderName & ", " & olItem.Subject & ", " & olItem.ReceivedTime & ", " & olItem.Body
        objTS.writeline
    Next
 
    objTS.Close
    Set olApp = Nothing
End Sub


As you can see this writes to an excel file, but doesn't put it in the format I need.
0
 
LVL 39

Expert Comment

by:nutsch
ID: 39962247
Try this update of your code:

Sub GetInbox()
    Dim olApp, olNamespace, olInbox, olItem, arrBody, lLoop As Long, sTemp As String
    Dim strFileName As String, objFS, objTS
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(6).Folders("0_Kevin")
    
    strFileName = "C:\test1.csv"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set objTS = objFS.GetFile(strFileName)
    If Err.Number <> 0 Then objFS.CreateTextFile strFileName
    On Error GoTo 0
    Set objTS = objFS.OpenTextFile(strFileName, 8)
 
    On Error Resume Next
    For Each olItem In olInbox.Items
        arrBody = Split(sBody, vbCrLf)
        sTemp = ""
        
        For lLoop = LBound(arrBody) To UBound(arrBody)
            sTemp = sTemp & """" & Mid(arrBody(lLoop), InStr(arrBody(lLoop), "=") + 1) & ""","
        Next
        
        objTS.Write sTemp
        objTS.WriteLine
    Next
 
    objTS.Close
    Set olApp = Nothing
End Sub

Open in new window

0
 

Author Comment

by:farmingtonis
ID: 39984229
For the last one it isn't actually writing anything to a file.  It doesn't error our, but also doesn't put in anything in the file.
0
 

Author Closing Comment

by:farmingtonis
ID: 39989213
I think i may have been a little confusing on my question.  I will need to repost with some clarity.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Learn more about how the humble email signature can be used as more than just an electronic business card. When used correctly, a signature can easily be tailored for different purposes by different departments within an organization.
Get an idea of what you should include in an email disclaimer with these Top 5 email disclaimer tips.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now