Loop through all cells in a table from Outlook email - vba

Question

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.

Answer 1

Try using InStr function MSDN
Example
Option Explicit
Public Sub Example()
Dim Item As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
If Application.ActiveExplorer.selection.Count = 0 Then
MsgBox "No Item selected!", vbCritical, "Error"
End If
For Each Item In Application.ActiveExplorer.selection
sText = Item.Body ' Email Body
vText = Split(sText, Chr(13)) ' Chr(13) = Carriage return
'// Check each line of text in the message body down loop
For i = UBound(vText) To 0 Step -1
'// InStr([start,]mainString, SearchedString[, compare])
If InStr(1, vText(i), "Name:") > 0 Then
'// Split vItem : & :
vItem = Split(vText(i), Chr(58)) ' Chr(58) = :
Debug.Print Trim(vItem(1)) 'Print on Immediate Window
End If
Next
Next
End Sub
Or use horizontal tab Chr(9)
See Character Chart
'Dec|Hex|Oct| Char | Description
'-------------------------------
'0 0 000 null
'1 1 001 start of heading
'2 2 002 start of text
'3 3 003 end of text
'4 4 004 end of transmission
'5 5 005 enquiry
'6 6 006 acknowledge
'7 7 007 bell
'8 8 010 backspace
'9 9 011 horizontal tab
'10 A 012 new line
'11 B 013 vertical tab
'12 C 014 new page
'13 D 015 carriage return
'14 E 016 shift out
'15 F 017 shift in
'16 10 020 data link escape
'17 11 021 device control 1
'18 12 022 device control 2
'19 13 023 device control 3
'20 14 024 device control 4
'21 15 025 negative acknowledge
'22 16 026 synchronous idle
'23 17 027 end of trans. block
'24 18 030 cancel
'25 19 031 end of medium
'26 1A 032 substitute
'27 1B 033 escape
'28 1C 034 file separator
'29 1D 035 group separator
'30 1E 036 record separator
'31 1F 037 unit separator
'32 20 040 space
'33 21 041 !
'34 22 042 "
'35 23 043 #
'36 24 044 $
'37 25 045 %
'38 26 046 &
'39 27 047 '
'40 28 050 (
'41 29 051 )
'42 2A 052 *
'43 2B 053 +
'44 2C 054 ,
'45 2D 055 -
'46 2E 056 .
'47 2F 057 /
'48 30 060 0
'49 31 061 1
'50 32 062 2
'51 33 063 3
'52 34 064 4
'53 35 065 5
'54 36 066 6
'55 37 067 7
'56 38 070 8
'57 39 071 9
'58 3A 072 :
'59 3B 073 ;
'60 3C 074 <
'61 3D 075 =
'62 3E 076 >
'63 3F 077 ?
'64 40 100 #
'65 41 101 A
'66 42 102 B
'67 43 103 C
'68 44 104 D
'69 45 105 E
'70 46 106 F
'71 47 107 G
'72 48 110 H
'73 49 111 I
'74 4A 112 J
'75 4B 113 K
'76 4C 114 L
'77 4D 115 M
'78 4E 116 N
'79 4F 117 O
'80 50 120 P
'81 51 121 Q
'82 52 122 R
'83 53 123 S
'84 54 124 T
'85 55 125 U
'86 56 126 V
'87 57 127 W
'88 58 130 X
'89 59 131 Y
'90 5A 132 Z
'91 5B 133 [
'92 5C 134 \
'93 5D 135 ]
'94 5E 136 ^
'95 5F 137 _
'96 60 140 `
'97 61 141 a
'98 62 142 b
'99 63 143 c
'100 64 144 d
'101 65 145 e
'102 66 146 f
'103 67 147 g
'104 68 150 h
'105 69 151 i
'106 6A 152 j
'107 6B 153 k
'108 6C 154 l
'109 6D 155 m
'110 6E 156 n
'111 6F 157 o
'112 70 160 p
'113 71 161 q
'114 72 162 r
'115 73 163 s
'116 74 164 t
'117 75 165 u
'118 76 166 v
'119 77 167 w
'120 78 170 x
'121 79 171 y
'122 7A 172 z
'123 7B 173 {
'124 7C 174 |
'125 7D 175 }
'126 7E 176 ~
'127 7F 177 DEL