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

本文介绍了如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 您好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 解决方案 ' 查找第1列的值 sPattern = \ b（任务|计划日期|截止日期|完成|时间工作|说明）\\ \\ b 您需要找到第二列的模式;） HiIm 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 1Task | Export ExcelPlaned-date | 02.05.2013deadline | 01.05.2013finished | notime effort | 3.5hdescription | sdfjl fs dfjsf df aslfj sfdlk | f djasfsdkfsdjfldjfsj | fas dfas sf aTable 2Task | ComputerPlaned-date | 02.05.2013deadline | 01.05.2013finished | notime effort | 3.5hdescription | sdfjl fs dfjsf df aslfj sfdlk | f djasfsdkfsdjfldjfsj | fas dfas sf aI 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.CurrentFolderSet 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 = TrueFor 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 Subthe 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 rtfCan anyone help me?Thanks & regards chendu 解决方案 这篇关于如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！