Copy a Table from outlook msg body to Excel on receiving mail

[bunnnnny]

Hi,
I want to copy a table from an email in outlook to excel automatically whenever I get a mail with subject "Tasks - <currentdate-month>" using VBA/macros
I get at least 10 mails each day throughout the month with the same subject. The email body contains a table in the following table format
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Associate[/TD]
[TD]Task[/TD]
[TD]Onshore[/TD]
[TD]Estimated hrs[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]task[/TD]
[TD]Name1[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]task[/TD]
[TD]Name1[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]task[/TD]
[TD]Name1[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]task[/TD]
[TD]Name2[/TD]
[TD]8[/TD]
[/TR]
</tbody>[/TABLE]
Each onshore lead will assign a task to their respective offshore associate. So each mail contains only few cells which are filled. For ex, onshore A will only assign task to associate A, B, and C in the above table. He fills associate name,task,onshore and estimated hrs and sends me back. Same way, Onshore B will assign task to few associates with task and estimated hrs. I have 10 onshore people.
So I need a macro code which triggers itself upon the mail arrrival with subject "Tasks - <Current Date - Month>" and writes only the columns A, B,C, D which are filled. The second mail trigger should write from the next column in the excel [appending the same excel sheet]
It would be of great help if someone can provide me the code as I have a target set for me by my manager[jan4].
thank u in advance

 

[bunnnnny]

Please help me do this. Im very new to VBA/macros.

 

[tonyyy]

bunnnnny,

The code below might get you started.

A few comments...
The code should be placed into a module in the Outlook VBA Project window;
Set a reference to the Microsoft Excel 14.0 Object Library;
Set a reference to the Microsoft HTML Object Library;
To set the trigger:
[TABLE="width: 716"]
<tbody>[TR]
[TD] 1. Click on Rules / Create Rule / Advanced Options…[/TD]
[/TR]
[TR]
[TD] 2. Checkmark "with specific words in the message header" [enter Tasks][/TD]
[/TR]
[TR]
[TD] 3. Checkmark "run a script" [select Project1.ExportTable][/TD]
[/TR]
[TR]
[TD] 4. Finish

Sub ExportTable(item As Outlook.MailItem)

' Set a reference to Microsoft Excel 14.0 Object Library
' Set a reference to Microsoft HTML Object Library
 
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myItem As Object
Dim xlApp As Object
Dim xlWb As Object
Dim i As Long
Dim j As Long
Dim LastRow As Long

Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then CreateObject ("Excel.Application")
On Error GoTo 0
xlApp.Visible = True
Set xlWb = xlApp.Workbooks.Add

For Each myItem In myFolder.Items
    If Left(myItem.Subject, 5) = "Tasks" Then
        Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
        Dim oElColl As MSHTML.IHTMLElementCollection
        Dim oMail As Outlook.MailItem
        With oHTML
            .Body.innerHTML = myItem.HTMLBody
            Set oElColl = .getElementsByTagName("table")
        End With
        
        LastRow = xlWb.sheets(1).Cells(xlWb.sheets(1).rows.Count, "A").End(xlUp).Row
        Dim x As Long, y As Long
        For x = 0 To oElColl(0).rows.Length - 1
            For y = 0 To oElColl(0).rows(x).Cells.Length - 1
                xlWb.sheets(1).Range("A" & LastRow + 1).Offset(x, y).Value = oElColl(0).rows(x).Cells(y).innerText
            Next y
        Next x
    End If
Next myItem

End Sub

The code was cobbled together from multiple sources. Special thanks to @VBA Geek for the section on exporting HTML tables from Outlook.

Oh, the code adds a new workbook to accept the Outlook table; it'll need to be modified if you want to append tables to an existing workbook.

Cheers,

tonyyy
[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 716"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[bunnnnny]

Thank u Tony.
Im testing it now.
Will keep you posted.
Thank u so much again.

 

[bunnnnny]

Im not getting a new workbook upon the arrival of a new mail with the specified subject.
Nothing seems to be happening. I did all the things mentioned above

 

[tonyyy]

bunnnnny,

A couple of questions please...

Are Macros enabled in Outlook? (I think the default is to disable all macros.)

When you receive a new mail message, which Folder / Subfolder is it delivered to? For example, Outlook Data File / Inbox? Or something else?

Cheers,

tonyyy

 

[bunnnnny]

Hi Tony,

Apologies for the late reply.

To answer your questions
1. Macros are enabled
2. All new items are in inbox by default. They are not moved to any folder.

I see that that book1 is getting opened and its blank one. Nothing is being written there

 

[tonyyy]

bunnnnny,

Thanks for the answers and feedback. It appears the first part of the code is working, but the second part isn't. For now I would consider two possibilities: 1) We're looking in the wrong folder; or 2) There aren't any messages that start with the word "Tasks".

To determine which of the two possibilities it might be, please ensure there's at least one message in your Inbox that starts with the word "Tasks", then paste the bold line of code in the appropriate place:

[COLOR=#a9a9a9]For Each myItem In myFolder.Items
     If Left(myItem.Subject, 5) = "Tasks" Then
          [/COLOR][B]MsgBox myItem.Parent.Parent[/B][COLOR=#a9a9a9]
          Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument[/COLOR]

When you trigger the code, there should be a message box that pops up in Outlook with a folder name. Please let me know the name of the folder, or please let me know if there's no message box.

Thanks,

tonyyy