none
Address cells in a table in an outlook message RRS feed

  • Question

  •    I regularly receive emails that contain items of data, some of which I wish to extract and copy to an Excel spreadsheet.  The body of the email contains only a table consisting of a single cell.  Within that cell are many lines of text and four further tables (of multiple rows and columns), one of which itself contains yet another table.  All the data that I require are within cells in the various tables in tables and the data are consistently in the same cell in each email.

       I would be grateful for guidance on how to address the cells in the various embedded tables in the body of an outlook email.

       As an aside, I did simply extract the whole body from the emails and paste it into Word to work on it there.  Regrettably, that transferred all the information, but removed the tables, and because of variations in the numbers of lines and spaces it proved impossible to write a procedure to find the data items.

    Tuesday, October 23, 2012 5:27 PM

Answers

  • What you are looking for is:

    Sub CopyToWord()
    Dim wdApp As Word.Application
    Dim objInspector As Inspector
    Dim wdDoc As Word.Document
    Dim objDoc As Word.Document
    Dim oRng As Word.Range
    Dim bStarted As Boolean
    Dim olItem As Outlook.MailItem
        If Application.ActiveExplorer.Selection.Count = 0 Then
            MsgBox "No Items selected!", vbCritical, "Error"
            Exit Sub
        End If
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err Then
            Set wdApp = CreateObject("Word.Application")
            bStarted = True
        End If
        On Error GoTo 0
        For Each olItem In Application.ActiveExplorer.Selection
            olItem.Display
            Set objInspector = ActiveInspector
            Set objDoc = objInspector.WordEditor
            objDoc.Range.Copy
            Set wdDoc = wdApp.Documents.Add
            wdDoc.Range.Paste
            olItem.Close olDiscard
        Next olItem
        Set objDoc = Nothing
        Set objInspector = Nothing
        Set wdDoc = Nothing
        Set wdApp = Nothing
        Set olItem = Nothing
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by AndyColRomsey Thursday, November 1, 2012 10:08 AM
    Thursday, November 1, 2012 8:14 AM

All replies

  • Assuming that all the e-mails have the same format (as appears to be the case from your question) can you post a sample message somewhere e.g. Dropbox or SkyDrive so that we can see exactly what you are trying to process?

    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, October 24, 2012 12:53 PM
  • Hi Graham

       Thank you for looking at this one.  I tried to save the email message (which I have edited to remove client personal data) as a .msg to dropbox.  When I checked the link, however, it opened up immediately in the browser with a load of gobbledygook – presumably html.  What I have done therefore is save the body as a word document and edited it to show the table borders in various formats.  The original has all borders blank, and one cannot even see that there are any tables till one opens the email and goes to edit mode.

       The link is https://dl.dropbox.com/u/51949344/ExampleEmail.doc (This link now removed)

       The information that we want to extract is in red and in large font.  What I would like to do is find a way to refer to the individual tables, then to tables within tables and then down to cells within those tables.  (Something like Item.Body.Table(1).Table(2).(Row1, Col 2)

       Simply using VBA to copy the body to a word document did not bring the tables across, so that the document produced was plain unformatted text with contents of the embedded tables in a different order and layout.  I was not able to find a way of using VBA to open an email and enter edit mode to try to copy the table across intact that way.  Is there a way?

       Regrettably the sender does not always use the same number of spaces and carriage returns.  So in the  unformatted word document,  finding keywords and advancing or reversing a set number of words / paragraphs might work in one email but not in the next!  So I see no alternative to finding individual cells and parsing the information therein to get the required data.

       With thanks

       Andy C


    Wednesday, October 24, 2012 3:03 PM
  • Sorry but I had forgotten about this thread. You are right. It does present a dilemma, and the fact that you will probably have different numbers of items is not going to help.

    If you can get the message into a document, like the one you posted, then it MAY be possible to extract the data. Perhaps something like the following, though I am not overconfident that it will work.

    Dim oDoc As Document
    Dim xlapp As Object
    Dim xlbook As Object
    Dim xlsheet As Object
    Dim NextRow As Long
    Dim NextCol As Long
    Dim oTable As Table
    Dim oCell As Cell
    Dim i As Long
    Dim vPara As Variant
    Dim vItem As Variant
    Dim vCountry As Variant
    Const strWorkbookname As String = "D:\My Documents\Test\Merge\WorkbookName.xlsx"

        On Error Resume Next
        Set xlapp = GetObject(, "Excel.Application")
        If Err Then
            Set xlapp = CreateObject("Excel.Application")
        End If
        On Error GoTo 0
        xlapp.Visible = True
        Set xlbook = xlapp.Workbooks.Open(Filename:=strWorkbookname)
        Set xlsheet = xlbook.Sheets(1)
        NextRow = xlsheet.Range("A" & xlsheet.Rows.count).End(-4162).Row + 1

        Set oDoc = ActiveDocument
        For Each oTable In oDoc.Tables
            For Each oCell In oTable.Range.Cells
                vPara = Split(oCell.Range.Text, Chr(11))
                For i = 0 To UBound(vPara)
                    Select Case i
                        Case 1, 2, 3, 4, 5, 6, 8, 9, 10
                        Case 7
                            xlsheet.Cells(NextRow, 1) = vPara(i)
                        Case 11
                            vCountry = Split(vPara(i), Chr(13))
                            xlsheet.Cells(NextRow, 2) = vCountry(1)
                        Case Else
                            If InStr(1, vPara(i), "Postage and packaging") > 0 Then
                                vItem = Split(vPara(i), Chr(13))
                                xlsheet.Cells(NextRow, 3) = Replace(vItem(11), Chr(7), "")
                            End If
                            If InStr(1, vPara(i), "Item Number") > 0 Then
                                vItem = Split(vPara(i), Chr(13))
                                NextCol = xlsheet.Cells(NextRow, xlsheet.Columns.count).End(-4159).Column + 1
                                If NextCol = 3 Then NextCol = NextCol + 1
                                xlsheet.Cells(NextRow, NextCol + 1) = Replace(vItem(1), Chr(7), "")
                                xlsheet.Cells(NextRow, NextCol + 2) = Replace(vItem(2), Chr(7), "")
                                xlsheet.Cells(NextRow, NextCol + 3) = Replace(vItem(3), Chr(7), "")
                                vItem = Split(vItem(0), Chr(32))
                                xlsheet.Cells(NextRow, NextCol) = Replace(vItem(2), Chr(7), "")
                            End If
                    End Select
                Next i
            Next oCell
        Next oTable


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, October 31, 2012 2:14 PM
  • Hi Graham

       Thank you for your reply and particularly for all that code.  I have not had time to test it yet, but I can see what it is doing.  As you point out, different numbers of items (and possibly different quantities of each item) will prove difficult, to say the least.  However, my immediate problem is that I cannot get the message into Word with its tables intact.  I can copy the body to word using something based on:

       ...

       wdDoc.Content = myOlMail.Body

       ...

    But that simply copies all the text across to a word document without the tables.

    I can open the selected item using

    Sub OpenItem()

        Dim olItem As Outlook.MailItem
        Dim olInspector As Object
        
        
        Set olItem = ActiveExplorer.Selection.Item(1)
        olItem.Display
        Set olInspector = Application.ActiveInspector
        
        olInspector.Activate
        
        Set olInspector = Nothing
        Set olItem = Nothing

    End Sub

    But having got it open in an inspector, I cannot work out the code to do the equivalent of:

        Ctrl + A  (Select All)

        Ctrl + C  (Copy)

        Click in a new word document (Activate a new document)

        Ctrl + V  (Paste into the new document)

    That gets it into a word document with tables intact, so that I can address the next stage of the problem as you have outlined above.  (If only there was a macro recorder in Outlook!)  Any guidance on how to achieve those four simple actions will be much appreciated.

    With thanks

    Andy C

    Wednesday, October 31, 2012 5:39 PM
  • What you are looking for is:

    Sub CopyToWord()
    Dim wdApp As Word.Application
    Dim objInspector As Inspector
    Dim wdDoc As Word.Document
    Dim objDoc As Word.Document
    Dim oRng As Word.Range
    Dim bStarted As Boolean
    Dim olItem As Outlook.MailItem
        If Application.ActiveExplorer.Selection.Count = 0 Then
            MsgBox "No Items selected!", vbCritical, "Error"
            Exit Sub
        End If
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err Then
            Set wdApp = CreateObject("Word.Application")
            bStarted = True
        End If
        On Error GoTo 0
        For Each olItem In Application.ActiveExplorer.Selection
            olItem.Display
            Set objInspector = ActiveInspector
            Set objDoc = objInspector.WordEditor
            objDoc.Range.Copy
            Set wdDoc = wdApp.Documents.Add
            wdDoc.Range.Paste
            olItem.Close olDiscard
        Next olItem
        Set objDoc = Nothing
        Set objInspector = Nothing
        Set wdDoc = Nothing
        Set wdApp = Nothing
        Set olItem = Nothing
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by AndyColRomsey Thursday, November 1, 2012 10:08 AM
    Thursday, November 1, 2012 8:14 AM
  • Graham

       Many thanks;  that is exactly what I wanted.

       In order to see the word documents created by the procedure I had to add after the  "Next olItem" line the following two lines:

         wdApp.Visible = True
         wdApp.WindowState = wdWindowStateNormal

    That then gives me documents that contain the complete mail body, including the tables.  I can now work on them to extract the data that I need.

    With thanks

    Andy C

    Thursday, November 1, 2012 10:08 AM