如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容 [英] How to recognize and read table content inside outlook's email (body of email) via VBA

问题描述

您好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，}）\ * * 

< blockquote>

' 查找第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 ;)

这篇关于如何通过VBA识别和阅读outlook的电子邮件（电子邮件正文）中的表格内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！