Click here to Skip to main content
13,002,133 members (76,509 online)
Rate this:
Please Sign up or sign in to vote.

Im new in VBA and need help.

I have in Outlook a folder with Statusmails.

Every day must every employee send a Statusmail end of the day, what they did on that day.

I want to export this Emails to Excel for a better View.

The table in the Email has always the same format.

The Table has two columns and is several times in the email.

Table 1
Task          |  Export Excel
Planed-date   |  02.05.2013
deadline      |  01.05.2013
finished      |  no
time effort   |  3.5h
description   |  sdfjl fs dfjsf df aslfj sfdlk 
              |  f djasfsdkfsdjfldjfsj
              |  fas dfas sf a
Table 2
Task          |  Computer
Planed-date   |  02.05.2013
deadline      |  01.05.2013
finished      |  no
time effort   |  3.5h
description   |  sdfjl fs dfjsf df aslfj sfdlk
              |  f djasfsdkfsdjfldjfsj
              |  fas dfas sf a

I can export now every email from the selected folder to excel with this code:
Sub Extract()
 On Error Resume Next
 Set myOlApp = Outlook.Application
 Set mynamespace = myOlApp.GetNamespace("mapi")
 Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
Set xlobj = CreateObject("excel.application.14")
 xlobj.Visible = True
 xlobj.Worksheets("Sheet1").Name = "Statusmail"
'Set the header
 xlobj.Range("a" & 1).Value = "Absender"
 xlobj.Range("a" & 1).Font.Bold = "True"
 xlobj.Range("b" & 1).Value = "Date"
 xlobj.Range("b" & 1).Font.Bold = "True"
 xlobj.Range("c" & 1).Value = "Task"
 xlobj.Range("c" & 1).Font.Bold = True
 xlobj.Range("d" & 1).Value = "Planed-date"
 xlobj.Range("d" & 1).Font.Bold = True
 xlobj.Range("e" & 1).Value = "deadline"
 xlobj.Range("e" & 1).Font.Bold = True
 xlobj.Range("f" & 1).Value = "finished"
 xlobj.Range("f" & 1).Font.Bold = True
 xlobj.Range("g" & 1).Value = "time effort"
 xlobj.Range("g" & 1).Font.Bold = True
 xlobj.Range("h" & 1).Value = "description"
 xlobj.Range("h" & 1).Font.Bold = True
For i = 1 To myfolder.Items.Count
  Set myitem = myfolder.Items(i)
  msgtext = myitem.Body
  xlobj.Range("a" & i + 1).Value = myitem.To
  xlobj.Range("b" & i + 1).Value = myitem.ReceivedTime
  xlobj.Range("c" & i + 1).Value = msgtext
 End Sub

the text from body is in "msgtext"

the code is implemented in Outlook.

How can I take the elements from the body and put it in a new cell???
the email format is rtf

Can anyone help me?

Thanks & regards chendu
Posted 24-Mar-13 22:40pm
Updated 24-Mar-13 22:43pm
Maciej Los 25-Mar-13 4:51am
Did you check BodyFormat[^] and HTMLBody[^] properties as i suggest you in comment to past solution.
chenduran10 25-Mar-13 5:02am
yes, but it didn't really help me
Maciej Los 25-Mar-13 5:19am
What you mean "didn't really help me"? When you set BodyFormat to html, HTMLBody returns table formated as HTML <table><tr><td>...</td><td>...</td></tr></table>.
chenduran10 25-Mar-13 5:37am
ahhh!!! okkehj that's a good way, i'll try it^.
But how can i select then the items?
Maciej Los 25-Mar-13 5:44am
First check it:
myItem.BodyFormat = olFormatHTML
MsgBox myItem.HTMLFormat, vbInformation, "HTML format of body"

and improve your question with new HTML formated text of body.
chenduran10 25-Mar-13 7:18am
can you add the solution? It only shows me the plain text
Maciej Los 25-Mar-13 7:26am
Please, improve your question and paste the exact text of message, unless the body of message is the same as has been posted in question.
chenduran10 25-Mar-13 8:48am
the body is the same as has been posted in question

1 solution

Rate this: bad
Please Sign up or sign in to vote.

Solution 1

Probably, no matter on BodyFormat (rtf/html/text), the only way to achieve that is to use VBScript.RegExp library.

To use it, you need to add reference in VBA editor as is shown here: simple-regular-expression-tutorial-for-excel-vba[^].

Many useful information, you'll find here: Microsoft Beefs Up VBScript with Regular Expressions[^] and here: Regular Expression (RegExp Object)[^]

Example patterns:
'find "Table 1", "Table 2", ..., "Table 33",... "Table 109", and so on
sPattern = "^\s*(Table\s\d{1,})\s*$"
'find values for column 1
sPattern = "\b(Task|Planed-date|deadline|finished|time effort|description)\b"

You need to find pattern for second column ;)
CHill60 25-Mar-13 21:04pm
My 5 - lot of effort into the answer
Maciej Los 26-Mar-13 2:53am
Thank you, Chill60 ;)
chenduran10 28-Mar-13 4:11am
Thank you for your answer, but I don't get it really... :(
Maciej Los 28-Mar-13 5:12am
How do you want to export "tables" from email to Excel (tabular format)?
Where do you want to store data (each table into another worksheet)?
chenduran10 28-Mar-13 8:16am
yes tabular format.
each table should be in one row in the same worksheet

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
Top Experts
Last 24hrsThis month

Advertise | Privacy | Mobile
Web01 | 2.8.170624.1 | Last Updated 25 Mar 2013
Copyright © CodeProject, 1999-2017
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100