您好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我现在可以使用此代码将所选文件夹中的每封电子邮件导出为excel :
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 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.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 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 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的电子邮件(电子邮件正文)中的表格内容
发布评论