Question

我无法只将Excel中需要的表格抓取。我正在使用的Word文档包含各种表格，但只有具有某些关键词的表格需要放入excel中。

代码循环遍历文件夹，为每个文件创建工作表，但是当在表中搜索关键短语时，我在第28行收到错误。

我是新手，所以任何建议都会受到赞赏

Sub FormatWordTables()

Dim WB As Workbook
Set WB = ThisWorkbook
Dim BOM As Worksheet
Set BOM = WB.Sheets("BoM")
lastBOM = BOM.Range("B" & Rows.Count).End(xlUp).Row

Dim file As String
file = Dir("C:\folder\*.docx")

' create worksheet with the name of the file
Do While file <> ""
ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = file
Dim wdDoc As Object
Set wdDoc = GetObject("C:\folder\" & file)

Dim TableNo As Long 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Long 'column index in Excel
Dim tblCount As Long
With wdDoc
    TableNo = wdDoc.tables.Count
    For tblCount = 1 To wdDoc.tables.Count
        ' search through tables in Doc for specific text
        With .tables(tblCount)
        Dim STable As Object
        Set STable = .Range(Start:=wdDoc.tables(tblCount).Cell(1, 1).Range.Start, _
        End:=wdDoc.tables(tblCount).Cell(2, .Columns.Count).Range.End)
        SText = "Identifying Text"
        Dim Match As Range
        Set Match = Nothing
        Set Match = STable.Find(What:=SText)

        ' if text is found copy data to excel sheet
        If Match <> 0 Then

            For iRow = 1 To .Rows.Count
               'find the last empty row in the current worksheet
                nextRow = ThisWorkbook.ActiveSheet.Range("a" _
                    & Rows.Count).End(xlUp).Row + 1
                For iCol = 1 To .Columns.Count
                .Cell(iRow, iCol).Range.Copy
                ThisWorkbook.ActiveSheet.Cells(nextRow, iCol).Activate
                ThisWorkbook.ActiveSheet.Paste
                Next iCol
            Next iRow
        End If
        End With
    Next tblCount
End With
Set wdDoc = Nothing

file = Dir()
Loop

End Sub

Answer 1

第16行缺少文件夹分隔符，应为：

Set wdDoc = GetObject("C:\folder\" & file)

编辑：所以你只是在表的前两行中查找文本。如下更改代码应该适合您。

With .tables(tblCount)
Dim STable As Range
Set STable = .Range
STable.MoveEnd wdRow, -(.Rows.Count - 2)

基于内容将Word表导入Excel

1 个答案: