从 Outlook 电子邮件循环遍历表格中的所有单元格

Question

我收到一封标准化的电子邮件，其中包含一个表格 (11R x 3C)，我只需要其中几个特定单元格的信息。

电子邮件中的表格格式如下。

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>      |

在表格中，我只对<Impt Info>、NameID、EmailID、ContactID 和CommentID 的值感兴趣。

我尝试使用debug.print 作为 Word 表格对象循环遍历表格，但由于某种原因，它会将整个表格视为单个单元格。我是否会错误地分配表对象或只是使用错误的代码？

以下是我尝试使用的代码：

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

当前代码将值导出到 Excel 中，而我可能只是从 Excel 中进行操作。但是，我想最终将信息直接泵入 Access DB。因此，需要得出特定的值。

Answer 1

尝试使用 InStr function MSDN

例子

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

或者使用水平制表符Chr(9)

查看字符表

'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