Copy Table from Email Body to Excel Sheet and Keep Format

Hi

I hv following observations

1) Polaris test is an empty file with sheets AL FL GA INKY MN MO OH
2) in what sheet should the data be imported ?
3) you mention that 1 email it import correctly I see in the file Polaris-what-it-should-be.xls 1 table is imported only where as both emails have several tables !!! so do not understand how it is working on 1 email.

Pls answer above questions so we can go further
gowflow

Sorry for item 3) I just scrolled down and indeed it copied the whole table. Pls advise for itmes 1 and 2
gowflow

Also you are importing everything into A1 of sheet AL is this what you want ??? or you want to import the emails one after the other in sheet AL pls specify
gowflow

One of the most popular ways of doing this is to copy the data then paste it into an Excel "Template".
The template will contain the formatting.

Or create a macro in Excel that does the formatting.

It looks like the body of these emails is actually HTML and not just text.

So perhaps you should look at HTMLBody and not Body.

Here's some code that gets the tables from  the HTML in the table.

It's pretty rough and still needs some work but it works with both messages.

Option Compare Database
Option Explicit

Public Sub PolarisEmails()
' Outlook declarations
Dim olApp As Outlook.Application
Dim objFolder As Outlook.Folder
Dim objNameSpace As Outlook.NameSpace
Dim objItems As Outlook.Items
Dim objMess As MailItem
Dim strFilter As String
Dim strSubject

    ' Excel declarations
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Const xlShiftDown = -4121

    ' general declarations
Dim strTxtFileName As String
Dim IE As Object
Dim doc As Object

    strFilter = "[Categories]=""Polaris-AL"""

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.GetDefaultFolder(6)

    Set objFolder = objFolder.Folders("Excel Stuff")

    objFolder.Items.Sort "[Received]", False

    Set objItems = objFolder.Items

    objItems.Sort "[Received]", True

    Set objMess = objItems.Find(strFilter)

    If objMess Is Nothing Then Exit Sub

    strSubject = objMess.Subject
    
    Set xlApp = CreateObject("Excel.Application")
    
    Set xlWB = xlApp.Workbooks.Add
    
    xlApp.DisplayAlerts = False

    Set xlWS = xlWB.Sheets(1)

    strTxtFileName = "C:\SampleEmail.html"

    Open strTxtFileName For Output As #1

    Write #1, objMess.HTMLBody

    Close #1

    Set IE = CreateObject("InternetExplorer.Application")

    IE.navigate strTxtFileName


    Set doc = IE.Document

    GetAllTables doc, xlWS

    xlWS.Range("A1").Resize(2).EntireRow.Insert xlShiftDown
    
    xlWS.Range("A1") = strSubject
    IE.Quit

    xlApp.Visible = True

    Set objMess = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objNameSpace = Nothing
    Set olApp = Nothing
End Sub


Sub GetAllTables(doc, ws)

    Dim rng As Object
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim I As Long

    For Each tbl In doc.getElementsByTagName("TABLE")

        tabno = tabno + 1

        nextrow = nextrow + 1

        Set rng = ws.Range("B" & nextrow)

        rng.Offset(, -1) = "Table " & tabno

        For Each rw In tbl.Rows

            For Each cl In rw.Cells
                rng.Value = cl.outerText
                Set rng = rng.Offset(, 1)
                I = I + 1
            Next cl

            nextrow = nextrow + 1

            Set rng = rng.Offset(1, -I)
            I = 0
        Next rw

    Next tbl

    ws.Cells.ClearFormats

End Sub

Select allOpen in new window

Hi!  Thank you for your help.  The answers to your questions...

1.  Polaris_TEST is basically a template... Once this is working for AL, I will be using variations of this code to pull tables from other emails into the other tabs and then ultimately the workbook will be saved with all the tabs filled.

2.  For purposes of this test, I am importing the data into AL.  I am only importing the data from one email into each tab, so it will always go into A1.  (I hope this makes sense)

I have not tried HTMLbody; honestly, I didn't know it was an option.

I will be out all day, but will test it when I get home.

Thank you!

rsburge

Here it is pls check the attach file and advise if this is what your looking for.

Pls not my comments:
1) you mentioned that your code imported the first email but not the second its correct as you are not looping through all emails which this version does.
2) This version keeps the format web intact so you get data and formating also.
3) this version will import in sheet AL all the emails the first one will come in the last row used in sheet AL the second email will skip 2 blank rows after the last row and will paste the data there etc...
4) This versio has a dashboard where you will get a trace of what is happening
5) You will need to add reference to Microsoft Internet Controls to do so, load this file goto Developper menu and choose Visual Basic the from the menu tools choose Refrences and from the list locate Microsoft Internet Controls select it then press ok save the file close it and start it again.
6) LAst but not least maybe 1 email was imported for you cos it is labeled with the Catergory Polaris but the second isn't. You have to make sure all the emails that you want to import need to be in the Category Polaris.

Pls check and let me know your comments.

gowflow
importEmails---Final.xlsm

gowflow

You don't need any additional references, late-binding can be used.

That's what I did in the code I posted.

True, but is asker want to learn some VBA properties then its would help. But the workbook posted has a refrence to Microsoft Internet COntrols and if it is not ticked then it would fault reason why I mentioned it. I could hv removed it but choose to keep it to help asker.
gowflow

Actually I don't think you really need Internet Explorer if you are using a web query.

You just need to save the HTMLBody from the email to a file.

The reason I used IE was because I didn't think of using a web query.:)

goflow...  Thank you for the code you posted.  I like the way it works; I do need to have each email go into a separate tab.  I also need to limit the import to the tables only, and exclude the forwarded by lines.

The sample code I posted is what I was using to test only...  Once I had something working, then I was going to incorporate looking for the other emails.

Each email will have a slightly different subject line; i.e. they will include "AL", "KY", "MN", ect (state abbreviations).  I need a tab for each state abbreviation; thus the multiple tabs in the test template I posted.

imnorie...  I also tried the code you posted; it works, however tables 1-4 and some of the others don't paste in the proper columns, rather they paste as one cell (see attached) polaris-test-imnorie-sample.xls

pls give me the format of the subjext so I can have them go to the proper worksheet. As far as other lines we can remove these provided the tables are all the same format or the lines to remove are the same also I will need your help to adivse what you want to remove
gowflow

Thank you for all of your help!  
The format of the subject will vary.  I have a program, Automate Pro, that processes emails as they come in and it assigns the category to the emails.  This is why I started the code looking for the category.  The category and corresponding tab in the workbook are listed below.

As for deleting the rows, every row before the row with "Rates Effective" in column "M" should be deleted.  This will always be at the top of the table in each email.

Polaris-AL = tab AL
Polaris-FL = tab FL
Polaris-GA = tab GA
Polaris-IN = tab IN
Polaris-KY = tab KY
Polaris-MN = tab MN
Polaris-MO = tab MO
Polaris-OH = tab OH

Thank you for this new version...  I will test this tomorrow morning.

Thank you for all of your help!  This works beautifully for what I am trying to do.

your welcome anytime
gowflow

Hey, no points for suggestion using HTMLBody and saving it as a file?

Only kidding.:)