Question

我正在编写一个excel宏，以从特定文件夹中存在的word文档中提取数据。

我重用了在Word文档上运行良好的宏，它将在新的Excel工作表中提供所有详细信息。

在word文档中，数据存在于具有两列的表中（第一列是模式，第二列是描述）。

表中的行数到处都不相同。该表位于标题3下。

例如：表格说明

与表中的数据一起，我要复制标题和节号（标题3类型）。

但是使用下面的代码，我可以从表中正确提取数据。但是它正在复制标题和节号的最后一个实例。例如：对于Pattern_1，Pattern_2，Pattern_3，它正在复制节名称为3.2.2，标题为Usecase2

Public Sub exportTableData()
    Dim t
    Dim r

    Dim ID As String
    Dim prefix As String

    Dim xR As Integer
    Dim xROld As Integer
    Dim chapter As String
    Dim useCase As String
    Dim text1 As String
    Dim text2 As String

    Dim docPath As String
    Dim docList As String
    Dim Workbook As Object
    Dim wordApp As Object
    Dim docObj As Object

    MsgBox "Please close all the Microsoft Word Applications"

    Do
        On Error Resume Next
        Set wordApp = GetObject(, "Word.Application")
        If Not wordApp Is Nothing Then
            wordApp.Quit
            Set wordApp = Nothing
        End If
    Loop Until wordApp Is Nothing

    ' track Excel worksheet row number
    xR = 2

    docPath = "folder which contains the DOcuments"
    ' get the list of all documents in the folder
    docList = Dir(docPath & "\*.doc", vbNormal)

    ThisWorkbook.Sheets("TableData").Activate

    While docList <> ""
        Set wordApp = CreateObject("Word.Application")
        wordApp.Visible = False
        Set docObj = wordApp.Documents.Open(Filename:=SRS_Path & "\" & docList, AddToRecentFiles:=False, Visible:=False)

        prefix = "Pattern"
    With wordApp.ActiveDocument
            ' Setup search to find usecase and corresponding section number
            wordApp.Selection.WholeStory
            wordApp.Selection.Find.ClearFormatting
            wordApp.Selection.Find.Style = "Heading 3"

            With wordApp.Selection.Find
                .Text = ""
                .Replacement.Text = ""
                .Forward = False
                .Wrap = wdFindContinue
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With

            wordApp.Selection.Find.Execute
    useCase = wordApp.Selection.Text
            ' Determine the string for chapter
            chapter = "Chapter " & wordApp.Selection.Range.ListFormat.ListString

      ' Loop through all tables in active Word document
            For Each t In srsDoc.Tables
                On Error Resume Next
                t.Range.Select
                ' xR tracks the current row in the Excel worksheet
                xROld = xR

                ' Loop through rows in the current table
                For Each r In t.Rows
                    text1 = r.Cells(1).Range.Text
                    ' Check if cell text start with prefix
                    If InStr(text1, prefix) = 1 Then
                        ' Check if row is not empty
                        If Not (r Is Nothing) Then
                            text2 = r.Cells(2).Range.Text
                            ThisWorkbook.ActiveSheet.Cells(xR, 1) = xR - 1
                            ThisWorkbook.ActiveSheet.Cells(xR, 2) = chapter
                            ThisWorkbook.ActiveSheet.Cells(xR, 3) = useCase
                            ThisWorkbook.ActiveSheet.Cells(xR, 4) = text1
                            ThisWorkbook.ActiveSheet.Cells(xR, 5) = Left(text2, Len(text2) - 2)
                            xR = xR + 1
                        End If
                    End If
                Next r
            Next t
    End With
        ' Clean up.
        docObj.Close
        wordApp.Quit
        Set wordApp = Nothing
        Set docObj = Nothing
    docList = Dir()
    Wend
    Workbook.ActiveSheet.Cells.EntireColumn.AutoFit
End Sub

输出：

复制表的节号和标题时出现问题

0 个答案: