Export from Outlook to Excel

[pzamory]

I receive emails with a brief example below. I'd like to be able to automatically take this data out of Outlook and format it right into an Excel sheet and have each subsequent email append to the bottom of the sheet.

Phone #: 2015551212
Name: Joe Smith
State: NJ

Can this be done?

Thanks

 

[Derek Brown]

Yes, it can be done using VBA.
I have pulled the following code from one of my workbooks and removed some of the 'other actions' that was being done to try to leave just the important bits for you.
Pay particular attention to the names of the worksheets (Audit, Merge Data, Control Sheet etc.) that it uses and make sure that you create these in the workbook that you use to test this code. Cell B3 on the Control Sheet contained the delimiter as this code expected several records per email message with the fields being separated by a particular character not used elsewhere in the record. Each record was terminated by a carriage-return. The format of your email suggest that you have the record split across several lines so you will have to change the code to look for 'keywords' (e.g. "Phone #:").
Note also the comment at the beginning of the code - you need reference to the Outlook Object Library.
The process prompts for the user to select the email folder, writes each email in turn to a textfile and then reads that text file into Excel, appending to the 'Merge' worksheet. The process will work whether or not Outlook is running.
Good luck and have fun!

Option Explicit
Public gblStopProcessing As Boolean
Sub ReadOutlookMessages()
' requires Microsoft Outlook Object Library (Tools/References}
Dim wb As Workbook
Dim ws As Worksheet
Dim wsAudit As Worksheet
Dim wsControl As Worksheet
Dim objFolder As Object
Dim objMsg As Object
Dim objNSpace As Object
'
Dim objOutlook As Outlook.Application
'
Dim blRecordsHaveFormulas As Boolean
Dim blColourCell As Boolean
'
Dim strDelimiter As String
Dim strText As String
Dim lngAuditRecord As Long
Dim lngKount As Long
Dim lngRecordsInEmail As Long
Dim lngRow As Long
Dim lngSaveType As Long ' olTXT save type
Dim lngTotalItems As Long
Dim lngTotalRecords As Long
Dim intFormulasEndColumn As Integer
Dim intFormulasStartColumn As Integer
Dim intFreefile As Integer
Dim intKount As Integer
'
 On Error GoTo HandleError
'
    ' Initialise:
     Set wb = ThisWorkbook
     Set wsControl = wb.Worksheets("Control Sheet")
     strDelimiter = wsControl.Range("B3").Value
     blColourCell = False
     lngAuditRecord = 1 ' Start row
     lngSaveType = 0 ' save as .txt
     lngTotalRecords = 0
'
    ' Read email messages:
     Application.ScreenUpdating = False
     Set objOutlook = CreateObject("Outlook.Application")
     Set objNSpace = objOutlook.GetNamespace("MAPI")
'
    ' Allow user to choose folder:#
     Set objFolder = objNSpace.pickfolder
    ' Check if cancelled:
     If objFolder Is Nothing Then
         gblStopProcessing = True
         MsgBox "Processing cancelled"
        Exit Sub
    End If
'
     lngTotalItems = objFolder.Items.Count
     If lngTotalItems = 0 Then
         MsgBox "Outlook folder contains no email messages", vbOKOnly + vbCritical, "Error - Empty Folder"
         gblStopProcessing = True
        GoTo HandleExit
    End If
     If lngTotalItems > 0 Then
         On Error Resume Next
             Application.DisplayAlerts = False
             wb.Worksheets("Merge Data").Delete
             wb.Worksheets("Audit").Delete
             Application.DisplayAlerts = True
         On Error GoTo HandleError
         wb.Worksheets.Add after:=Worksheets(Worksheets.Count)
         Set ws = ActiveSheet
         ws.Name = "Merge Data"
         wb.Worksheets.Add after:=Worksheets(Worksheets.Count)
         Set wsAudit = ActiveSheet
         wsAudit.Name = "Audit"
         wsAudit.Range("A1") = "Email data imported on " & Now()
         lngAuditRecord = lngAuditRecord + 1
         wsAudit.Cells(lngAuditRecord, 1) = "Subject"
         wsAudit.Cells(lngAuditRecord, 2) = "Sender's Email Address"
         wsAudit.Cells(lngAuditRecord, 3) = "Email Creation Time"
         wsAudit.Cells(lngAuditRecord, 4) = "Email Received Time"
         wsAudit.Cells(lngAuditRecord, 5) = "Records Imported"
         wsAudit.Range(Cells(lngAuditRecord, 1), Cells(lngAuditRecord, 1)).Select
         Selection.EntireRow.Font.Bold = True
         Selection.HorizontalAlignment = xlCenter
         lngAuditRecord = lngAuditRecord + 1
         ws.Activate
         lngRow = 1 ' start row in worksheet "Merge Data"
         For lngKount = 1 To lngTotalItems
             Application.StatusBar = "Reading message " & lngKount & " of " & lngTotalItems
             Set objMsg = objFolder.Items(lngKount)
             objMsg.SaveAs ThisWorkbook.Path & "\temp321.txt", lngSaveType
             Close
             intFreefile = FreeFile
             Open ThisWorkbook.Path & "\temp321.txt" For Input As #intFreefile
             lngRecordsInEmail = 0
             Do Until EOF(intFreefile)
                 Line Input #intFreefile, strText
                 If InStr(1, strText, strDelimiter) > 0 Then
                     ws.Cells(lngRow, 1).Value = strText
                     If blColourCell Then
                         ws.Cells(lngRow, 1).Interior.ColorIndex = 35
                    End If
                     lngRow = lngRow + 1
                     lngTotalRecords = lngTotalRecords + 1
                     lngRecordsInEmail = lngRecordsInEmail + 1
                End If
             Loop
             Close
            ' switch cell colouring:
             blColourCell = Not blColourCell
'
' Update Audit record:
             On Error Resume Next
             wsAudit.Activate
             wsAudit.Cells(lngAuditRecord, 1) = objFolder.Items(lngKount).Subject
             wsAudit.Cells(lngAuditRecord, 2) = objFolder.Items(lngKount).SenderEmailAddress
             wsAudit.Cells(lngAuditRecord, 3) = objFolder.Items(lngKount).CreationTime
             wsAudit.Cells(lngAuditRecord, 4) = objFolder.Items(lngKount).ReceivedTime
             wsAudit.Cells(lngAuditRecord, 5) = lngRecordsInEmail
             wsAudit.Range("A1").Select
             wsAudit.Cells.Columns.AutoFit
             lngAuditRecord = lngAuditRecord + 1
             On Error GoTo HandleError
'
             ws.Activate
        Next lngKount
         Kill ThisWorkbook.Path & "\temp321.txt"
   End If
'
' Check that records have been found:
     If lngTotalRecords = 0 Then
         MsgBox "No records were found for import", vbOKOnly + vbCritical, "Error - no records found"
         gblStopProcessing = True
        GoTo HandleExit
    End If

HandleExit:
     On Error Resume Next
     Application.ScreenUpdating = True
     Set objNSpace = Nothing
     Set objFolder = Nothing
     Set objMsg = Nothing
     Set objOutlook = Nothing
     Set ws = Nothing
     Set wsAudit = Nothing
     Set wsControl = Nothing
     Set wb = Nothing
'
     If Not gblStopProcessing Then
            MsgBox "Processing completed" & vbCrLf & vbCrLf & _
               "Please check results", vbOKOnly + vbInformation, "Information"
    End If
'
    Exit Sub
'
HandleError:
    MsgBox Err.Number & vbCrLf & Err.Description
    gblStopProcessing = True
    Resume HandleExit
End Sub

Hope that this helps.

 

[Derek Brown]

I have been asked for an explanation of the use of "FreeFile" so I am adding it to this post in case it is of interest to others.
By using "FreeFile" the system provides a number that is not being used (e.g. it is 'free' for use). It can then be used for the opening of a text file instead of trying to 'guess' a number that can be used. This number is passed to the Open command to be used in code that will process the file. The example given later just uses "Close" but, particularly if working with more than one file, could have been "Close #intFreefile".

So here you see the intFreefile value being assigned to the file being opened;
used in the loop control "until EOF" (End Of File);
and used in the 'Line Input' command - this reads a line into a text string, one character at a time until it reaches the end-of-line codes (these will be ignored).
(Hey - Line Input - that takes me back to the good old days of Basic running on computers in the 1980s).

Perhaps I should have excluded the next five lines of code - these were specific to what I was doing at the time: Emails were being received from another (non-Windows) computer system and being moved to another folder for processing by this code. To ensure that mistakes were not made by wrong emails being included in that folder, I insisted that each required record in the emails to be processed each had a unique delimiter (ideally something that could not be entered from the keyboard). The 'Instr' function checked for the existence of that terminator and, if found, moved the complete record to a single cell (in the next available row) in the worksheet (formulas would then 'split' that cell content to other cells).
Again the colouring of cells was a specific requirement at the time and does nothing in the transferring of data from Outlook to Excel.
Use of text files seemed to be the popular method of getting data from the email body into another application. A good reference for processing text files is:
http://pubs.logicalexpressions.com/pub0009/LPMArticle.asp?ID=622
By the way, Jon's website (www.peltiertech.com) is excellent if you want to find out how to create almost any type of chart.
So the process is:
Save the email as a text file.
Read each line in the text file and move it to Excel either splitting the fields at the same time or, as I did, moving each to one cell and allow formulas to 'split' the record.
In my example, I also created an Audit Trail of the processing.

 

[de ware]

I have been asked for an explanation of the use of "FreeFile"...

That was me asking...

Thx for the further explanation.
I've been working on this the whole day, it alomost works...
The only problem is, when I choose a mail folder with for example 3 mails, the code loops trough the routine 3 times but always with the same mail.

- Can you see what's wrong in the code below?
- A second question, of minor importance. Can I specify the folder to look in in the routine? I once miss-clicked and chose "Inbox", it takes for ever to run through all my mails...

Thx again!

Option Explicit
Public gblStopProcessing As Boolean
Sub ReadOutlookMessages()
' requires Microsoft Outlook Object Library (Tools/References}
Dim wb As Workbook
Dim ws As Worksheet
Dim objFolder As Object
Dim objMsg As Object
Dim objNSpace As Object
'
Dim objOutlook As Outlook.Application
'
Dim strDelimiter As String
Dim strText As String
Dim lngTotalRecords As Integer
Dim lngRow As Long
Dim lngSaveType As Long ' olTXT save type
Dim lngTotalItems As Long
Dim intFreefile As Integer
Dim lngKount As Integer
Dim isDatum As Variant
On Error GoTo HandleError
' Initialise:
     Set wb = ThisWorkbook
     lngSaveType = 0 ' save as .txt
     lngTotalRecords = 0
     lngRow = 1 ' start row in worksheet "import"
 
' Read email messages:
      Application.ScreenUpdating = False
      Set objOutlook = CreateObject("Outlook.Application")
     Set objNSpace = objOutlook.GetNamespace("MAPI")
' Allow user to choose folder:#
     Set objFolder = objNSpace.pickfolder
' Check if cancelled:
     If objFolder Is Nothing Then
         gblStopProcessing = True
         MsgBox "Processing cancelled"
        Exit Sub
     End If
' Items in folder tellen
     lngTotalItems = objFolder.Items.Count
 
' Doorgaan indien mail gevonden
     If lngTotalItems = 0 Then
         MsgBox "Outlook folder contains no email messages", vbOKOnly + vbCritical, "Error - Empty Folder"
         gblStopProcessing = True
        GoTo HandleExit 'naar exit indien 0
     End If
 
     If lngTotalItems > 0 Then 'indien berichten in folder
 
         On Error Resume Next
             Application.DisplayAlerts = False
             wb.Worksheets("import").Delete     'sheet "import" verwijderen
             Application.DisplayAlerts = True
         On Error GoTo HandleError
 
            wb.Worksheets.Add after:=Worksheets(Worksheets.Count)  'sheet toevoegen
            Set ws = ActiveSheet
            ws.Name = "import"                                 ' naam nieuwe sheet wijzigen in "import"
 
 
 
 
 
         For lngKount = 1 To lngTotalItems 'van eerste mail tot totaal aantal mails
 
                 Set objMsg = objFolder.Items(lngKount)
                 objMsg.SaveAs ThisWorkbook.Path & "\temp321.txt", lngSaveType
                 Close
 
                 ws.Activate
 
                 intFreefile = FreeFile
                 Open ThisWorkbook.Path & "\temp321.txt" For Input As #intFreefile
 
                 Do Until EOF(intFreefile)
                     Line Input #intFreefile, strText
                     If strText <> "" Then
 
                     isDatum = IsDate(strText)
                     Select Case isDatum
                        Case True
                        ws.Cells(lngRow, 1).Value = DateValue(strText)
                        lngRow = lngRow + 1
                        Case Else
                        ws.Cells(lngRow, 1).Value = strText
                        lngRow = lngRow + 1
                     End Select
 
                     End If
                 Loop
                 Close
 
                 On Error Resume Next
                 On Error GoTo HandleError
 
                 ws.Activate
 
             Kill ThisWorkbook.Path & "\temp321.txt"
             MsgBox "call"
         Call FindValues
         Next lngKount
 
    End If
HandleExit:
     On Error Resume Next
     Application.ScreenUpdating = True
     Set objNSpace = Nothing
     Set objFolder = Nothing
     Set objMsg = Nothing
     Set objOutlook = Nothing
     Set ws = Nothing
     Set wb = Nothing
     Kill ThisWorkbook.Path & "\temp321.txt"
     Exit Sub
HandleError:
    MsgBox Err.Number & vbCrLf & Err.Description
    gblStopProcessing = True
    Resume HandleExit
 
End Sub
Sub FindValues()
Dim wb As Workbook
Dim ws As Worksheet
Dim wc As Worksheet
Dim wi As Worksheet
Dim isin() As Variant
Dim i, j, p, d, t As Integer
Dim isinnr As String
Dim isinToFind As String
Dim Foundisin As String
Dim FoundValue As Double
Dim FoundDate As Variant
Dim DateC As Variant
Dim isDatum As Variant
 
' Initialise:
    isinnr = "blabla"
    Foundisin = "blablabla"
    Set wb = ThisWorkbook
    Set wi = wb.Worksheets("import")
    Set wc = wb.Worksheets("carmignac")
    i = 2
    p = 1
' Get ISIN Numbers
    For i = 2 To 100
        isinnr = wc.Cells(1, i).Value
            Select Case isinnr
                Case Is <> ""
                ReDim Preserve isin(i - 1)
                isin(i - 1) = isinnr
                i = i + 1
                Case Else
                Exit For
            End Select
    Next
 
' Get NAV Date
        For d = 1 To 1000
            FoundDate = wi.Cells(d, 1).Text
 
            Select Case FoundDate
                Case "gepubliceerd op "
                FoundDate = DateValue(wi.Cells(d - 1, 1).Value)
                MsgBox FoundDate
                Exit For
                Case ""
                MsgBox "Geen datum gevonden"
                Exit Sub
            End Select
        Next
 
' Get NAV
    For j = 1 To UBound(isin)
        isinToFind = isin(j)
 
        Do Until Foundisin = isinToFind Or Foundisin = ""
        Foundisin = wi.Cells(p, 1).Text
        p = p + 1
        Loop
 
' Export to carmignac
    'Find NAV DATE
    For t = 2 To 10000
        DateC = wc.Cells(t, 1).Text
        isDatum = IsDate(DateC)
        Select Case isDatum
            Case True
            DateC = DateValue(DateC)
                Select Case DateC
                    Case FoundDate
                    Exit For
                    Case ""
                    MsgBox "Geen datum gevonden"
                    Exit Sub
                End Select
             End Select
    Next
 
    'paste NAV
    FoundValue = wi.Cells(p + 1, 1).Value
    wc.Cells(t, j + 1).Value = FoundValue
 
    Next j
 
'Exit
     Set ws = Nothing
     Set wb = Nothing
End Sub

 

[Derek Brown]

I can find nothing obviously wrong with the code but notice that you are deleting (Kill) the temporary file within the loop whereas I allowed for it to be overwritten and then deleted at the end of processing. However, I cannot see how that difference would cause the problem that you described.
I suggest that you step through the code in debug mode and after saving the email as the text file and closing it, locate the text file and open it to confirm that the content is always the same as the first email.
Regarding the question about specifying the folder to be searched, have a look at the following post where I specify the folder (in this case it is the Inbox).
http://www.mrexcel.com/forum/showthread.php?t=465135

 

[lawtonl]

Derek_Brown,

I've used your code and it works great for extracting information from Outlook however I'd like to be able to extract just certain parts of the email and I'm struggling to find out how I do this using your code.

I get an email that's in html format and I'd like to extract some of the information from a table within the email

It looks a little like this:

<TABLE style="WIDTH: 966pt; BORDER-COLLAPSE: collapse; mso-yfti-tbllook: 1184; mso-padding-alt: 0cm 0cm 0cm 0cm" class=MsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=1288><TBODY><TR style="HEIGHT: 15.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext 1pt solid; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 69pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=92>Company Name<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 57pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=76>Company URL<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 95pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=127>Company Employees<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 83pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=111>Company PC Count<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 75pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=100>Industry<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 93pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=124>Business Segmentation<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 93pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=124>Business Sub-Segmentation<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 102pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=136></TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 102pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=136>Lead Created Date<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 87pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=116>Preferred Comm Language<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; PADDING-LEFT: 0cm; WIDTH: 110pt; PADDING-RIGHT: 0cm; BACKGROUND: black; HEIGHT: 15.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=147>SSP Alias<o></o>
</TD></TR><TR style="HEIGHT: 15pt; mso-yfti-irow: 1; mso-yfti-lastrow: yes"><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext 1pt solid; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; WIDTH: 69pt; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm" width=92> Blah
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> <o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> 25 - 49<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> <o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> Legal Services<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> SMB<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> <o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> <o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> 1/18/2011 5:00 PM<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> English<o></o>
</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: #d4d0c8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 0cm; PADDING-RIGHT: 0cm; HEIGHT: 15pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: windowtext 1pt solid; PADDING-TOP: 0cm"> <o></o>
</TD></TR></TBODY></TABLE>

I'd like the information to be copied into the spreadsheet from the email.

Is this possible to do by altering the procedure you posted here?