Linked Questions

Popular Questions

Loop through all cells in a table from Outlook email

Asked by At

I have a standardized email that is sent to me that contains a table (11R x 3C) of which I only require the information from a couple of specific cells.

The table format from the email as follows.

1  |<Empty>  |<Empty>  |<Empty>  |
2  |         <Useless info>      |
3  |         <Impt Info>         |
4  |Name:    |NameID   |<Empty>  |
5  |Email:   |EmailID  |<Empty>  |
6  |Contact: |ContactID|<Empty>  |
7  |Comment: |CommentID|<Empty>  |
8  |         <Useless Info>      |
9  |         <Useless Info>      |
10 |         <Useless Info>      |
11 |         <Useless Info>      |

Of the table, I am only interested in values of <Impt Info>, NameID, EmailID, ContactID and CommentID.

I've tried looping through the table using debug.print as a Word table object but for some reason it sees the entire table as a single cell. Could I be assigning the table object wrongly or simply using the wrong codes?

Below is the code I've tried to use:

Sub test()
    Dim objMail As Outlook.MailItem
    Dim objWordDocument As Word.Document
    Dim objTable As Word.Table
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim I As Long
    Dim SavePath As String
    Dim SaveName As String

    'Create a new excel workbook
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    objExcelApp.Visible = True

    'Get the table(s) in the selected email
    Set objMail = Outlook.Application.ActiveExplorer.Selection.item(1)
    Set objWordDocument = objMail.GetInspector.WordEditor

    SavePath = "C:\Users\John.Grammaticus\Desktop\Test\"
    SaveName = objMail.SenderName & " " & objMail.Subject

    Set objTable = objWordDocument.Tables(1)

    For Each C In objTable.Range.Cells
        Debug.Print C.Range.Text
    Next C

    objTable.Range.Copy

    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelWorksheet.Paste


    objExcelWorkbook.SaveAs FileName:=SavePath & " " & SaveName
    objExcelWorkbook.Close
End Sub

The current code exports the values into an Excel and I could potentially just manipulate from Excel instead. However, I would like to eventually pump the info directly into an Access DB. Hence the need to draw out specific values.

Related Questions