从Word表中检索信息

时间:2016-12-02 10:00:05

标签: vba ms-word range

我有一个Word文档,其中有一个被隐藏文本标签包围的部分<答案> ......一些表......< /答案>。 Word宏可以返回这些标记之间的文本范围(以前是书签,但必须要去)。

我想从Excel做的是打开Word文档,获取标记之间的范围,迭代该块中的表并从每行中检索一些单元格。然后将这些单元格数据写入新Excel工作表的某些行中。

我看到很多Word / Excel自动化,但没有一个能激发我在两段文本之间检索范围。最好的是能够在Word中运行Word宏RetrieveRange(strTagName,rngTextBlock)以返回rngTextBlock中“Answers”的范围,但这似乎不可能。

作为背景:.docm文件是一份带有答案和最高分的试卷,我想将其转移到Excel中,以包含每个学生的评分。

1 个答案:

答案 0 :(得分:0)

浏览更多网站,我遇到了一个C#示例,它部分地完成了我需要的工作:而不是使用Word的SELECTION棒来查找范围。我现在可以在两个标签之间找到文本块,但在遍历其表和表行时仍然失败。没有编译器错误(并在Word本身工作)但我必须缺少一个外部链接......

Function CreateSEWorksheet() As Boolean
  ' Find <ANSWERS> in Word Document, and traverse all tables and write them as rows in worksheet

  Dim wdrngStart As Word.Range
  Dim wdrngEnd As Word.Range
  Dim wdrngAnswers As Word.Range
  Dim wdTable As Word.Table
  Dim wdRow As Word.Row
  Dim strStr As String
  Dim bGoOn As Boolean

' Following set elsewhere:
' Set WDApp = GetObject(class:="Application.Word")
' Set WDDoc = WDApp.Documents.Open(filename:="filespec", visible:=True)

  Set wdrngStart = WDDoc.Range  ' select entire document - will shrink later
  Set wdrngEnd = WDDoc.Range
  Set wdrngAnswers = WDDoc.Range

  ' don't use Word SELECT/SELECTION but use ranges instead when finding tags.
  If wdrngStart.Find.Execute(findText:="<ANSWERS>", MatchCase:=False) Then
     ' found!
     wdrngAnswers.Start = wdrngStart.End
     If wdrngEnd.Find.Execute(findText:="</ANSWERS>", MatchCase:=False) Then
        wdrngAnswers.End = wdrngEnd.Start
        bGoOn = True
     Else
        ' no closing tag found
        bGoOn = False
     End If
  Else
     'no opening tag found
     bGoOn = False
  End If

If bGoOn Then
   For Each wdTable In wdrngAnswers.Tables
      ' ** below doesn't work anymore: object doesn't support this method **
      For Each wdRow In wdTable
         ' as example, take column 4 of each row
         strStr = wdRow.Cells(4).Range.Text
         strStr = Left(strStr, Len(strStr) - 2) ' remove end of cell markers
         Debug.Print strStr
      Next
   Next
   CreateSEWorksheet = True
Else
   CreateSEWorksheet = False
End If

End Function