如何使用vba解析outlook表,以自动更新quickparts?

时间:2015-05-29 10:23:46

标签: vba outlook outlook-vba

我试图在没有任何成功的情况下找到我的问题的答案,所以如果之前有人问过,请道歉。

我有一个包含表的Outlook消息表,我想用vba解析它以创建或更新快速部分条目。

表格如下所示:

+-----+--------------+--------------+
| xxx |       A      |       B      |
+-----+--------------+--------------+
|  1  |   sampleA1   |   sampleB1   |
+-----+--------------+--------------+
|  2  |   sampleA2   |   sampleB2   |
+-----+--------------+--------------+
|  3  |   sampleA3   |   sampleB3   |
+-----+--------------+--------------+

我的目标是生成快速部件,其ID将是例如" xxxA1"以及相应的文字" sampleA1"。

ID将从表的第一个单元格以及行和列标题构造,值将是相应的单元格内容。

我希望这很清楚。

任何帮助将不胜感激。 克里斯

1 个答案:

答案 0 :(得分:0)

好的,我已经设法阅读了表格,但我现在无法找到如何访问Quickparts来存储我刚读过的内容。

到目前为止我的代码看起来像这样。

Sub ParseTable2QuickParts()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objDoc As Object 'Word.Document
    Dim objSel As Object 'Word.Selection

    Dim cTitle As String
    Dim acRow(10) As String
    Dim nRow As Integer
    Dim acCol(10) As String
    Dim nCol As Integer
    Dim acValues(10, 10) As String

    On Error Resume Next
    Set objOL = Application
    If objOL.ActiveInspector.EditorType = olEditorWord Then
        Set objDoc = objOL.ActiveInspector.WordEditor
        Set objNS = objOL.Session

        Set objSel = objDoc.Windows(1).Selection

        objSel.Move wdstory, -1
        objSel.Move wdTable, 1
        objSel.Expand 12
        cTitle = Left(objSel.Text, Len(objSel.Text) - 2)

        For nCol = 2 To 3
           objSel.Move wdRow, 0
           objSel.Move wdCell, 1
           objSel.Expand 12
           acCol(nCol) = Left(objSel.Text, Len(objSel.Text) - 2)
        Next

        For nRow = 2 To 4
           objSel.Move wdRow, 1
           objSel.Move wdCell, 0
           objSel.Expand 12
           acRow(nRow) = Left(objSel.Text, Len(objSel.Text) - 2)
        Next

        objSel.Move wdstory, -1
        objSel.Move wdTable, 1
        For nRow = 2 To 4
            objSel.Move wdRow, 1
            For nCol = 2 To 3
                objSel.Move wdCell, 1
                objSel.Expand 12
                acValues(nCol, nRow) = Left(objSel.Text, Len(objSel.Text) - 2)
            Next
        Next

        objSel.Move wdstory, 1
        For nRow = 2 To 4
            For nCol = 2 To 3
                objSel.InsertAfter cTitle & acCol(nCol) & acRow(nRow) & " => " & acValues(nCol, nRow) & vbCrLf
            Next
        Next

    End If
    Set objOL = Nothing
    Set objNS = Nothing

End Sub

我只需要替换最后的嵌套循环来存储我读过的内容而不是将其转储回消息中。有人能指出我正确的方向吗?