VBA Outlook.尝试从电子邮件正文中提取特定数据并导出到Excel

Question

我在这里找到了很多指南让我到达目前的位置,但是我需要一些帮助来完成我的代码(我是一个完全的新手,所以请耐心等待).我试图在Outlook中使用VBA从我在Outlook的某个文件夹中的电子邮件中导出数据以获得优秀.我需要从众多电子邮件的邮件正文中提取数据到excel表中.我从中提取的电子邮件模板可以在下面找到.我需要参考编号后面的10位数字,序列号后面的10位数字和问题描述后的7位数字.(如果不清楚的话,我已经加了我需要的部分)

亲爱的先生/女士xxxxxxxx,

------------------不需要的信息-----------------

参考编号1234567890.

状态:----不需要信息-----

序列号:XXXXXXXXXX问题描述:______________(这里的数据可能略有不同,我只是想从这个区域拉一个7位数字,但如果不能这样做那么就这样吧)_______

用这个….

-----------------其余部分不需要-----------------------

到目前为止,我已经能够创建一个脚本来浏览我当前所在的Outlook文件夹,打开Excel工作表,在Excel中命名标题,然后导入数据.然而,它拉动整个身体而不仅仅是我需要的部分,并将它们放入excel的错误列中.不幸的是,因为我是一个完整的新手.我能够在这个网站上找到一些与解决方案类似的问题的例子,但我无法理解它们.通过大量的试验和错误,我已经使用了自己发布,任何帮助将非常感激.这是我目前的化身代码 -

    Sub Extract()
    On Error Resume Next
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")

    ‘open the current folder, I want to be able to name a specific folder if possible…

    Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
    Set xlobj = CreateObject("excel.application.14")
    xlobj.Visible = True
    xlobj.Workbooks.Add
    'Set Heading

    xlobj.Range("a" & 1).Value = "Case Number"
    xlobj.Range("b" & 1).Value = "HDD Serial Number"
    xlobj.Range("c" & 1).Value = "Sys Serial Number"
    xlobj.Range("d" & 1).Value = "User"


    For i = 1 To myfolder.Items.Count
    Set myitem = myfolder.Items(i)
    msgtext = myitem.Body

    ‘search for specific text
    delimtedMessage = Replace(msgtext, "reference number", "###")
    delimtedMessage = Replace(delimtedMessage, "Problem description:", "###")
    delimtedMessage = Replace(delimtedMessage, "Serial Number:", "###")
    messageArray = Split(delimtedMessage, "###")
    ‘write to excel
    xlobj.Range("a" & i + 1).Value = messageArray(1)
    xlobj.Range("b" & i + 1).Value = messageArray(2)
    xlobj.Range("c" & i + 1).Value = messageArray(3)
    xlobj.Range("d" & i + 1).Value = myitem.To

    Next
    End Sub

我到目前为止使用过的参考文献: 使用VB/VBA搜索Outlook邮件并将特定数据提取到Excel工作表 中我使用了另一个我无法找到链接的文件,以及reddit上的一个帖子,但我仍然卡住了.我不确定这是否是实现我想要的结果的最佳方式,因为这是我第一次尝试这样的事情.我愿意改变一切.提前致谢

Answer 1

对于"完全新手"来说似乎非常好的代码

您的代码非常接近工作.你似乎错过的是理解Array变量"messageArray"是如何工作的.

默认情况下,数组从零开始,然后从那里向上移动.所以具有3个可能值的数组将被标注为

dim messageArray(3) as string  
 -'meaning an array with 3 possible values all of which are strings

并且要填充该变量,您需要将代码从您拥有的更改为此

xlobj.Range("a" & i + 1).Value = messageArray(0)  ' Not 1 
xlobj.Range("b" & i + 1).Value = messageArray(1)  ' Not 2
xlobj.Range("c" & i + 1).Value = messageArray(2)  ' Not 3

另一件需要注意的事情是使用分割功能,分隔符非常优雅,但您的数据列最终可能不只是客户编号,而是客户编号加上一大堆文本.不想.您可能需要考虑起始和结束分隔符.

例如,正如您所拥有的那样,您当前正在阅读的电子邮件中的文本

参考编号1234567890.
状态:----不需要信息-----
序列号:XXXXXXXXXX Pro .......

您的分隔符将找到关键词"参考编号"和"序列号",并留下您的文字看起来像这样

### **1234567890**.  '
*STATUS: ----not needed info-----* 
### **XXXXXXXXXX** Pro.......

这样你的数据的第一列将包含一切的两个分隔符"###"意味着你的第一列将包含所有的这间:

> **1234567890**.
> *STATUS: ----not needed info-----*

而不仅仅是这个

1234567890.

最简单的解决方案是在'STATUS'处添加另一个分隔符,并添加另一个名为'status'的列.最终会有4列和所有数据整齐地细分.

我发现这已经有一段时间了,我希望这会有所帮助.为疯狂的格式化而道歉,我之前没有在StackOverflow上发布过.