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

Question

我在这里找到了很多指南，这些指南使我达到了目前的水平，但我需要一些帮助来完成我的代码(我在这方面完全是新手，所以请耐心等待) 。我正在尝试在 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

到目前为止我使用过的引用资料: 奥 git _a 我用过另一个，但找不到链接，在 reddit 上也有一个帖子，但我仍然卡住了。 我不确定这是否是实现我想要的结果的最佳方法，因为这是我第一次尝试这样的事情。我愿意改变任何事情。提前致谢

Answer 1

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

您的代码非常接近工作。您似乎错过了理解数组变量“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 函数的使用，分隔符非常优雅，但是你的数据列最终可能不只是客户编号，而是客户编号加上一大堆文本你可能不想要。您可能需要考虑开始和结束分隔符。

例如，正如您所看到的，当前显示的是电子邮件中的文本

Reference number 1234567890.
STATUS: ----not needed info-----
Serial Number: XXXXXXXXXX Pro.......

您的分隔符将找到关键字“引用号”和“序列号”，并留下如下所示的文本

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

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

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

而不仅仅是这个

1234567890.

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

我可以看到你发布这篇文章已经有一段时间了，我希望这会有所帮助。 对于疯狂的格式，我深表歉意，我之前没有在 StackOverflow 上发布过。