通过从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数据库。因此，有必要绘制出具体数值。

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