VBA 展望.尝试从电子邮件正文中提取特定数据并导出到 Excel [英] VBA Outlook. Trying to extract specific data from email body and export to Excel

问题描述

我在这里找到了相当多的指南，这些指南让我了解了我目前所处的位置，但我需要一些帮助来对我的代码进行最后的润色(我在这方面完全是新手，所以请耐心等待).我正在尝试在 Outlook 中使用 VBA 从我在 Outlook 的某个文件夹中的电子邮件中导出数据，以使其脱颖而出.我需要将大量电子邮件的消息正文中的数据提取到 Excel 表中.我从中提取的电子邮件模板可以在下面找到.我需要参考编号后的 10 位数字，序列号后的 10 位数字和问题描述后的 7 位数字.(我把我需要的部分加粗，以防不清楚)

尊敬的xxxxxxxx先生/女士，

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

参考号1234567890.

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

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

使用这个……

-----------------剩下的就不需要了-----------------------

到目前为止，我已经能够制作一个脚本来浏览我当前所在的 Outlook 文件夹，打开一个 Excel 工作表，在 excel 中命名标题，然后导入数据.但是，它不仅会拉动整个身体，而且会拉动我需要的部分，并将它们放入 excel 中错误的列中.不幸的是，这是我所能得到的，因为我在这方面是一个完全的新手.我能够在此站点上找到一些具有类似解决方案问题的示例，但我无法理解它们.通过多次试验和错误，我已经诉诸于张贴自己，任何帮助将不胜感激.这是我当前版本的代码-

 子提取()出错时继续下一步设置 myOlApp = Outlook.Application设置 mynamespace = myOlApp.GetNamespace("mapi")‘打开当前文件夹，如果可能的话，我希望能够命名一个特定的文件夹......设置 myfolder = myOlApp.ActiveExplorer.CurrentFolderSet xlobj = CreateObject("excel.application.14")xlobj.Visible = Truexlobj.Workbooks.Add'设置标题xlobj.Range("a" & 1).Value = "案例编号"xlobj.Range("b" & 1).Value = "硬盘序列号"xlobj.Range("c" & 1).Value = "系统序列号"xlobj.Range("d" & 1).Value = "User"对于 i = 1 到 myfolder.Items.Count设置 myitem = myfolder.Items(i)msgtext = myitem.Body'搜索特定文本delimtedMessage = Replace(msgtext, "参考编号", "###")delimtedMessage = Replace(delimtedMessage, "问题描述:", "###")delimtedMessage = Replace(delimtedMessage, "序列号:", "###")messageArray = Split(delimtedMessage, "###")'写到卓越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下一个结束子

到目前为止我使用过的参考资料:使用VB/VBA搜索 Outlook 邮件并将特定数据提取到 Excel 工作表中还有一个我用过的，我找不到链接，还有 reddit 上的一个线程，但我仍然卡住了.我不确定这是否是实现我想要的结果的最佳方式，因为这是我第一次尝试这样的事情.我愿意改变任何事情.提前致谢

解决方案

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

您的代码非常接近工作.您似乎错过了了解数组变量messageArray"的工作原理.

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

dim messageArray(3) 作为字符串-'意思是一个有 3 个可能值的数组，所有值都是字符串

并填充该变量，然后您需要将代码从您拥有的内容更改为这个

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

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

例如，正如您所拥有的，您的电子邮件中的文本当前正在读取

<块引用>

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

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

### **1234567890**.'*状态:----不需要信息-----*### **XXXXXXXXXX** 专业......

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

>**1234567890**.>*状态:----不需要信息-----*

而不仅仅是这个

<块引用>

1234567890.

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

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

I have found quite a bit of guides on here that have gotten me to where I am currently at, but I need some help putting the finishing touches on my code (I'm a complete novice at this so bear with me). I am trying to use VBA within outlook to export data from the emails I have in a certain folder of my Outlook to excel. I need to extract data from the message body of numerous emails into an excel sheet. The email template I am extracting from can be found below. I need the 10 digit number after reference number, the 10 digit number after serial number, and the 7 digit number after problem description. (I have bolded the parts I need in case that was not clear)

Dear Mr/Ms xxxxxxxx,

------------------Not Needed Info-----------------

Reference number 1234567890.

STATUS: ----not needed info-----

Serial Number: XXXXXXXXXX Problem Description: ______________(the data here can vary slightly, I am only concered with pulling a 7 digit number from this area but if that can’t be done then so be it)_______

Use this….

-----------------The rest is not needed-----------------------

So far I have been able to make a script that will browse the Outlook folder I am currently in, open an Excel sheet, name the headers in excel, and import the data. However, it pulls the entire body not just the segments I need and is putting them into the wrong columns in excel. That is as far as I can get unfortunately since I am a complete novice at this. I was able to find some examples on this site with a similar issue with solutions, but I wasn’t able to make much sense of them. Through much trial and error I have resorted to posting myself, and any help would be much appreciated. Here is my code in its current incarnation-

    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

References I've used thus far: Using VB/VBA to search Outlook messages and extract specific data into Excel worksheet There was another I used that I cannot find the link for, and a thread on reddit as well, but I am still stuck. I am not sure if any of this is the best way to achieve the results I want as this is my first attempt at something like this. I am open to changing anything. Thanks in advance

解决方案

Seems like very nice code for a "Complete Novice"

Your code is very close to working. The thing that you seem to have missed is understanding how the Array variable "messageArray" is working.

Arrays by default start at zero , and move up from there. so an Array with 3 possible values would be Dimensioned as

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

and to fill that variable you would then need to change your code from what you have to this

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

The other thing to be aware of , is the use of split function, and the delimiters is very elegant, but your columns of data may end up with not just the customer number, but the customer number plus a whole bunch of text that you may not want. You might need to consider a starting and ending delimiter.

For example, as you have it, your text from the email currently reads

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

You delimiters will find the key words "reference number" and "Serial number" and leave you with your text looking like this

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

in this way your first column of data will contain everything between the two delimiters '###' meaning your first column will contain all of this:

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

instead of just this

1234567890.

The simplest solution would be to add another delimiter at 'STATUS' and add another column called 'status' You would end up with 4 columns and ALL data neatly sub-divided.

I can see it was quite a while since you posted this , I hope this helps. Apologies all for the crazy formatting, I haven't posted on StackOverflow before.

这篇关于VBA 展望.尝试从电子邮件正文中提取特定数据并导出到 Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！