Macro to read email and update spreadsheet

[bobbybrown]

Hi everyone,
I have been searching for a solution to my task for a little while now but haven't found anything that would help.
I have a spreadsheet that at the moment I am having to update manually. The sheet records sales of items on ebay.
I sell 2 types of items and when I sell an item, I open the sheet and increase the number sold for that particular item.
This then increases the number sold for that particular item and the sheet works everything out itself from that point.

What I am trying to do is....Have excel read an email (I can route them through outlook that isn't a problem) and update the sheet.

What it would need to do is scan the inbox for emails from ebay and find the relevant text to decide if its product 1 or prouduct 2, check the amount sold then amend the cell on the spreadsheet by adding that number.

For example, if my sheet says I have sold 5 of item 1, I then sell 3 of item 1 and the email comes through, the sheet should automatically update the total sold to 8 items.

Can anyone offer any advice on this? Is it possible?

Many thanks for the time you have taken to read this message.

 

[bobbybrown]

Does anyone have any ideas with this?

Thanks for reading

 

[John_w]

Yes, this is certainly possible, using the Outlook object model, so you'll have to receive the emails in Outlook.

See if the following code gets you started. It is just basic code for looping through emails in the Outlook Inbox with "@ebay" in the sender's email address and displaying the email body text.

Some things you will need to define and change the code to handle:

1. What is the specific sheet and cell addresses of the 2 product sold counts?

2. How to find or identify the number sold in the email body text.

3. How to prevent Inbox emails being processed again when you run the code again. There are 3 methods I can think of: you manually move emails to another folder; or the code automatically moves emails to another folder; or the code looks at the email received time and processes only those emails received after the last run time.

Put the following code in a standard module. In the VBA editor, click Tools -> References and tick "Microsoft Outlook xx.0 Object Library", where xx.0 is the Outlook version.

Public Sub Read_Outlook_Emails()

    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outItem As Object
    Dim outMail As Outlook.MailItem
    
    Set outApp = New Outlook.Application
    Set outNs = outApp.GetNamespace("MAPI")
    
    'Get Inbox folder
    
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox)
        
    'Loop through emails in Inbox
    
    For Each outItem In outFolder.Items
    
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            
            Set outMail = outItem
            
            If InStr(outMail.SenderEmailAddress, "@ebay") > 0 Then
                MsgBox outMail.Body
            End If

        End If
    Next
    
    MsgBox "Finished"
    
End Sub

 

[bobbybrown]

That is excellent many thanks indeed. I will give that a try tomorrow when I am back on my home laptop.
I would say the option to have the code only process emails after the last run time would be best all around. Also, I know from memory the specific sheet is called Overview and the cells on my worksheet are:
F5 for Product1
F7 for Product2.

Many thanks again!

 

[bobbybrown]

Righty, here is where we are at so far.
I have added the code to the sheet and got it working to the point where it pops up a box that i have to click ok on for each email it find, it copies a bunch of the text from the email body to the pop up box.
Outlook is automatically putting the emails in to a seperate folder and the script is finding that folder and reading the emails.

What I can't figure out how to do now is:
1: Have the script ignore emails its read already
2: Take the quantity and type from the email it reads and update the relevant total on the spreadsheet by adding the quantity sold to the total.

The total sold for Product1 is in F5 and total for Product2 is in F7, both on the sheet called Overview.

The emails that come through are all the same, they are ebay sold item emails.

The body is basically this:

Once you receive payment from your buyer, please send your item within 1 days. 
[TABLE="width: 100"]
<tbody>[TR]
[TD]
		
		
	


	

		
	
[/TD]
[/TR]
</tbody>[/TABLE]
Print ebay shipping label

eBay postage labels are an easy and convenient way to purchase postage and automatically upload tracking information.

If you are not using an eBay postage label, please manually upload tracking information or mark your item as sent in My eBay.

My sold items
[TABLE="width: 100"]
<tbody>[TR]
[TD]Title[/TD]
[TD]Title of product (Also says which type it is)
[/TD]
[/TR]
[TR]
[TD]Seller User Name:[/TD]
[TD]Seller username[/TD]
[/TR]
[TR]
[TD]End time:[/TD]
[TD]24-Jul-15 15:28:55 BST[/TD]
[/TR]
[TR]
[TD]Sale price:[/TD]
[TD]£5.50[/TD]
[/TR]
[TR]
[TD]Quantity:[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]Quantity sold:[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Quantity remaining:[/TD]
[TD]16[/TD]
[/TR]
[TR]
[TD]Buyer:[/TD]
[TD]Buyers details[/TD]
[/TR]
</tbody>[/TABLE]

The code I am using in excel now is this: It has been updated ever so slightly since it was posted above.

Public Sub Read_Outlook_Emails()

    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outItem As Object
    Dim outMail As Outlook.MailItem
    
    Set outApp = New Outlook.Application
    Set outNs = outApp.GetNamespace("MAPI")
    
    'Get Inbox folder
    
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("ebay")
        
    'Loop through emails in Inbox
    
    For Each outItem In outFolder.Items
    
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            
            Set outMail = outItem
            
            If InStr(outMail.SenderEmailAddress, "@ebay") > 0 Then
                MsgBox outMail.Body
            End If

        End If
    Next
    
    MsgBox "Finished"
    
End Sub

Can anyone help with some pointers of how to do the rest of what I need it to do? Already made some good progress with the help of the code that was posted earlier, thank you very much for that.

 

[John_w]

1: Have the script ignore emails its read already

The code can save the latest received time seen by the last run of the code, and only process emails whose ReceivedTime is later.

I see from your above post that the item details are in a HTML table with 2 columns and 8 rows. To extract the product type and quantity sold, it will be easier for me to see an actual email, otherwise a lot is guessing is needed. If you are happy to send me an example email (anonymise the details if you want) then send me a PM and I will reply with my email address.

Just to note - the first code wasn't finding any emails because it was looking in the Inbox folder, whereas your emails are in the ebay subfolder of the Inbox.

    Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("ebay")

 

[bobbybrown]

That's right John, at first it wasn't finding emails as my outlook had another data file as the default inbox, it wouldn't let me change this so instead I set up a rule to move all emails to the default inbox then further move any eBay ones for sold items to the eBay folder. Updated that line of the code and the pop ups started as expected.

Have just sent you a PM

 

[John_w]

I was just about to post updated code with my 'best guess' for identifying the product type and extracting the quantity sold number, however I will wait for your example email.

 

[bobbybrown]

It's in your inbox now.

 

[John_w]

Try this code on a test workbook.

Public Sub Update_Products_Sold()

    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outFolder As Outlook.MAPIFolder
    Dim outItem As Object
    Dim outMail As Outlook.MailItem
    Dim product1 As Range, product2 As Range
    Dim lastRunReceivedTime As Range, latestReceivedTime As Date
    Dim parts As Variant, quantitySold As Integer
    Dim numEmailsFound As Integer
    
    With ThisWorkbook.Worksheets("Overview")
        Set product1 = .Range("F5")
        Set product2 = .Range("F7")
        Set lastRunReceivedTime = .Range("B1")
    End With
    
    Set outApp = New Outlook.Application
    Set outNs = outApp.GetNamespace("MAPI")
    
    'Get ebay subfolder within Inbox folder
    
    Set outFolder = outNs.GetDefaultFolder(olFolderInbox).Folders("ebay")
     
    'Loop through emails
    
    latestReceivedTime = lastRunReceivedTime.Value
    numEmailsFound = 0
    For Each outItem In outFolder.Items
    
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            
            Set outMail = outItem
            
            'Is this email from ebay and received after the latest received time of the last run?
            
            If outMail.ReceivedTime > lastRunReceivedTime.Value And _
                  InStr(1, outMail.SenderEmailAddress, "@ebay", vbTextCompare) > 0 Then
                            
                'Yes, so extract quantity sold, identify product type in subject and update appropriate Excel cell
                
                'MsgBox outMail.Body, Title:=outMail.Subject
                parts = Split(outMail.Body, "Quantity sold:")
                quantitySold = Split(parts(1), vbCrLf)(0)
                
                If InStr(1, outMail.Subject, "LEATHER", vbTextCompare) > 0 Then
                    product1.Value = product1.Value + quantitySold
                    numEmailsFound = numEmailsFound + 1
                ElseIf InStr(1, outMail.Subject, "PVC", vbTextCompare) > 0 Then
                    product2.Value = product2.Value + quantitySold
                    numEmailsFound = numEmailsFound + 1
                End If
                
                'Update latest received time
                
                If outMail.ReceivedTime > latestReceivedTime Then latestReceivedTime = outMail.ReceivedTime
                
            End If

        End If
    Next
    
    'Update cell containing latest received time of an ebay email
    
    lastRunReceivedTime.Value = latestReceivedTime
    lastRunReceivedTime.NumberFormat = "dd/mm/yyyy hh:mm:ss"

    MsgBox "Finished." & vbNewLine & "Number of emails found = " & numEmailsFound
    
End Sub

In addition to the F5 and F7 cells you described, the code saves in cell B1 the latest received time of the last run. This cell can be blank to start with and it will read all ebay emails regardless of their received time. Change "B1" in the code if you prefer a different cell for this purpose.