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

Posted 2023-03-15

【中文标题】VBA 展望。尝试从电子邮件正文中提取特定数据并导出到 Excel

【英文标题】：VBA Outlook. Trying to extract specific data from email body and export to Excel

【发布时间】：2014-04-28 02:54:50

【问题描述】：

我在这里找到了很多指南，这些指南让我到达了我目前所处的位置，但我需要一些帮助来完成我的代码（我是这方面的新手，所以请耐心等待） .我正在尝试在 Outlook 中使用 VBA 将我在 Outlook 的某个文件夹中的电子邮件中的数据导出到 Excel。我需要从大量电子邮件的消息正文中提取数据到 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

到目前为止我使用过的参考资料： Using VB/VBA to search Outlook messages and extract specific data into Excel worksheet 还有一个我用过的我找不到链接，还有一个关于 reddit 的帖子，但我仍然卡住了。 我不确定这是否是实现我想要的结果的最佳方法，因为这是我第一次尝试这样的事情。我愿意改变任何事情。在此先感谢

【参考方案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

还有一点需要注意，就是使用split函数，分隔符很优雅，但是你的数据列可能不只是客户编号，而是客户编号加上一大堆文本你可能不想要的。您可能需要考虑开始和结束分隔符。

例如，正如您所拥有的，您的电子邮件中的文本当前是这样的

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

您的分隔符将找到关键字“参考号”和“序列号”，并让您的文本看起来像这样

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

这样，您的第一列数据将包含两个分隔符“###”之间的所有内容 这意味着您的第一列将包含所有这些：

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

而不仅仅是这个

1234567890。

最简单的解决方案是在“STATUS”处添加另一个分隔符并添加另一个名为“status”的列 您最终会得到 4 列，并且所有数据都被整齐地细分。

我可以看到你发布这个已经有一段时间了，我希望这会有所帮助。 为疯狂的格式道歉，我之前没有在 *** 上发过帖子。