VBA Outlook. Trying to extract specific data from email body and export to Excel

Question

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

Solution

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.