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

时间:2019-02-07 02:54:55

标签: vba outlook outlook-vba

我收到了一封标准电子邮件,其中包含一个表格(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>NameIDEmailIDContactIDCommentID的值感兴趣。

我尝试使用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。因此,需要绘制出特定的值。

1 个答案:

答案 0 :(得分:2)

尝试使用 InStr function MSDN

示例

library(stringi)
stri_rand_strings(3, 5, pattern = "[A-Za-z0-9]")

或使用水平标签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)