Question

我正在编写宏来阅读以下电子邮件：

开始日期：2016年7月7日至2016年

volatile

我很高兴搜索“＃34;开始日期＆＃34;然后获取下一个13个字符，将其复制并粘贴到文本文件中。但我的问题是下一部分是表格格式。所以，当我在寻找名字时，约翰＆＃34;并尝试复制下10个字符。它没有用。

有没有办法搜索“＃34;接受＆＃34;并获取第一行数据（将为否），然后获取第二行数据（这将是否）？这可能吗？

此电子邮件表只有2行。所以，我不需要任何动态的方式来获取数据。有人可以指导我吗？

我首先尝试搜索互联网，但解决方案太庞大，我无法理解。有什么简单的方法吗？我甚至尝试过这里的解决方案：How to read table pasted in outlook message body using vba?但是当主体只有ON TABLE时该方法有效。但我的电子邮件将有文本和表格。

Answer 1

我从来没有真正用vba编程，但我想我可以帮助（有点）。

在您关联的帖子的答案中，有一行

Set msg = ActiveExplorer.Selection.item(1)

我认为您可以将此更改为

Set msg = Right(ActiveExplorer.Selection.item(1), 25)

删除表格前的文本（我从这里得到Right部分：http://www.exceltrick.com/formulas_macros/vba-substring-function/，但它也应该在Outlook中工作。）

这样，你就可以在表本身而不是整个消息上运行代码了。
如果表后面还有文本，可能会比较困难，但是你可以通过搜索桌子结束。

我希望这有帮助！

尝试2

经过一番搜索和思考，我想出了获取消息的html并使用它来解析表格的想法（好吧，不是，我从这里的评论中得到了它：http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus）。基于该源和其他来源，可以编写一个从电子邮件中获取表格的代码。

我写了一些可能有效的代码，但我无法测试它，因为我没有Outlook。另外，这是我第一次编写vba，因此可能存在很多语法错误（代码很难看）。

Sub GetTable()
    Dim msg As Outlook.mailItem
    Dim html As String
    Dim tableBegin As String
    Dim tableEnd As String
    Dim posTableBegin As Long
    Dim posTableEnd As Long
    Dim table As String
    Dim rowBegin As String
    Dim rowEnd As String
    Dim rowCount As Long
    Dim columnBegin As String
    Dim columnBeginLen As Long
    Dim columnEnd As String
    Dim posRowBegin As Long
    Dim posRowEnd As Long
    Dim values As String(0, 3)
    Dim beginValue0 As Long
    Dim beginValue1 As Long
    Dim beginValue2 As Long
    Dim EndValue0 As Long
    Dim EndValue1 As Long
    Dim EndValue2 As Long

    ' Get the message and the html
    Set msg = ActiveExplorer.Selection.item(1)
    html = msg.HTMLbody

    ' Get the begin and end positions of the table (within the html)
    tableBegin = "<table>"
    tableEnd = "</table>"

    posTableBegin = InStr(1, html, tableBegin)
    posTableEnd = InStr(posTableBegin, html, tableEnd)

    ' Get the html table
    table = Mid(html, posTableBegin + Len(tableBegin), posTableEnd - posTableBegin - Len(tableBegin))

    ' Set the variables for the loop
    rowBegin = "<tr>"
    rowEnd = "</tr>"
    rowCount = 0

    columnBegin = "<td>"
    columnBeginLen = Len(columnBegin)
    columnEnd = "</td>"

    ' Loop trough all rows
    posRowBegin = InStr(lastPos, table, rowBegin)
    Do While posRowBegin != 0
        ' Get the end from the current row
        posRowEnd = InStr(posRowBegin, table, rowEnd)
        rowCount = rowCount + 1

        ' Make the array larger
        ReDim Preserve values(rowCount + 1, 3)

        ' Get the contents from that row
        row = Mid(table, posRowBegin + Len(rowBegin), posRowEnd - posRowBegin - Len(rowBegin))

        ' Get the three values from that row (name, Accept, Approved) and put it in the array
        beginValue0 = InStr(1, row, columnBegin) + columnBeginLen
        endValue0 = InStr(beginValue0, row, columnEnd)
        beginValue1 = InStr(endValue0, row, columnBegin) + columnBeginLen
        endValue1 = InStr(beginValue1, row, columnEnd)
        beginValue2 = InStr(endValue1, row, columnBegin) + columnBeginLen
        endValue2 = InStr(beginValue2, row, columnEnd)

        values(rowCount, 0) = Mid(row, beginValue0, endValue0)
        values(rowCount, 1) = Mid(row, beginValue1, endValue1)
        values(rowCount, 2) = Mid(row, beginValue2, endValue2)

        ' Get the beginning of the next row
        posRowBegin = InStr(lastPos, table, rowBegin)
    Loop

    ' The values are now in the (double) array 'values'.
    ' values(0, [1-3]) contains the headers.

End Sub

如前所述，最初的想法来自http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus。此外，我使用Word VBA how to select text between two substrings and assign to variable?和Microsoft文档来编写此文件。

虽然代码可能不是开箱即用的，但我认为它仍然可以得到一般的想法（和一些细节），因此它可以用作指南。我希望这是你需要的解决方案！

Answer 2

您实际上可以使用Word对象模型从表中解析文本 - 假设电子邮件是HTML格式。

从Inspector.WordEditor属性获取Word.Document对象，并使用Word对象和方法获取文本，如下面的below example from MSDN。只需将ActiveDocument替换为您从WordEditor声明和设置的变量。

Sub ReturnCellContentsToArray() 
 Dim intCells As Integer 
 Dim celTable As Cell 
 Dim strCells() As String 
 Dim intCount As Integer 
 Dim rngText As Range 

 If ActiveDocument.Tables.Count >= 1 Then 
 With ActiveDocument.Tables(1).Range 
 intCells = .Cells.Count 
 ReDim strCells(intCells) 
 intCount = 1 
 For Each celTable In .Cells 
 Set rngText = celTable.Range 
 rngText.MoveEnd Unit:=wdCharacter, Count:=-1 
 strCells(intCount) = rngText 
 intCount = intCount + 1 
 Next celTable 
 End With 
 End If 
End Sub

使用宏读取Outlook邮件中的表格

2 个答案:

尝试2