如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容

本文介绍了如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

您好b $ b 我是VBA的新手，需要帮助。 我在Outlook中有一个包含Statusmails的文件夹。 每天必须每位员工发送当天结束的状态邮件，当天他们所做的事情。 我想将此电子邮件导出到Excel以获得更好的视图。 电子邮件中的表格格式始终相同。 表中有两列，在电子邮件中有几列。

表1 任务 |导出Excel 计划日期 | 02.05.2013 截止日期 | 01.05.2013 已完成 |没有 时间努力 | 3.5小时 描述 | sdfjl fs dfjsf df aslfj sfdlk | f djasfsdkfsdjfldjfsj | fas dfas sf a 表2 任务 |电脑 计划日期 | 02.05.2013 截止日期 | 01.05.2013 已完成 |没有 时间努力 | 3.5小时 描述 | sdfjl fs dfjsf df aslfj sfdlk | f djasfsdkfsdjfldjfsj | fas dfas sf a

我现在可以使用此代码将所选文件夹中的每封电子邮件导出为ex​​cel ：

Sub Extract（） On 错误 恢复 下一步 设置 myOlApp = Outlook.Application 设置 mynamespace = myOlApp.GetNamespace（ mapi） 设置 myfolder = myOlApp.ActiveExplorer.CurrentFolder 设置 xlobj = CreateObject（ excel.application.14） xlobj.Visible = True xlobj.Workbooks。添加 xlobj.Worksheets（ Sheet1）。Name = Statusmail ' 设置标题 xlobj.Range（ a& 1 ）。值= Absender xlobj.Range（ a& 1 ）。Font.Bold = True xlobj.Range （ b& 1 ） .Value = 日期 xlobj.Range（ b& 1 ）。Font.Bold = True xlobj.Range（ c& 1 ）。值= 任务 xlobj.Range（ c& 1 ）。Font.Bold = True xlobj.Range（ d& 1 ）。值= Planed-date xlobj.Range（ d& 1 ）。Font.Bold = True xlobj.Range（ e& 1 ）。值= 截止日期 xlobj.Range（ e& 1 ).Font.Bold = True xlobj.Range（ f& 1 ）。Value = finished xlobj.Range（ f& 1 ）。Font.Bold = True xlobj.Range（ g& 1 ）。值= time effort xlobj.Range（ g& 1 ）。Font.Bold = 真 xlobj.Range（ h& 1 ）。值= description xlobj.Range（ h& 1 ）。Font.Bold = True 对于 i = 1 至 myfolder.Items.Count 设置 myitem = myfolder.Items（i） msgtext = myitem.Body xlobj.Range（ a& i + 1 ）。Value = myitem。 To xlobj.Range（ b& i + 1 ）。值= myitem.ReceivedTime xlobj.Range（ c& i + 1 ）。Value = msgtext 下一步 结束 Sub

来自body的文本在msgtext中 代码在Outlook中实现。 怎么能我从身体中取出元素并将其放入一个新单元格中??? 电子邮件格式为rtf 任何人都可以帮助我？ 谢谢&关于chendu

解决方案

可能，无论在 BodyFormat （rtf / html / text），唯一的方法是实现就是使用 VBScript.RegExp 库。 要使用它，需要在VBA中添加引用编辑器如下所示： simple-regular-expression-tutorial -for-excel-vba [ ^ ]。 许多有用的信息，你会在这里找到：微软利用正则表达式提升VBScript [ ^ ]在这里：正则表达式（RegExp对象） [ ^ ] 示例模式：

' 查找表1，表2，...，表33，...表109，等等 sPattern = ^ \ * *（表\\\ {1，}）\ * *

' 查找第1列的值 sPattern = \ b（任务|计划日期|截止日期|完成|时间工作|说明）\\ \\ b

您需要找到第二列的模式;）

Hi 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.Workbooks.Add 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 Next 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

解决方案

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 ;)