Question

我正在寻找一个脚本，它将从文件夹中的每个单词doc中提取表格，并将每个表格结果放在excel中的一个工作簿/一个工作表中。我有太多的文件可以逐一完成。我还需要在最终的最后一列中输出它们的文件名（列H /或第9列，假设数据从列A /或列1开始导入）

我发现的代码非常有效，如果你一次只做一个文档，但是当你为下一个单词doc运行它时，它会覆盖excel中的先前数据（见下文）。

（我现在在下面使用的内容 - 需要我整天通过一个文件夹）

Option Explicit

Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim tableNo As Integer 'table number in Word
    Dim iRow As Long 'row index in Excel
    Dim iCol As Integer 'column index in Excel
    Dim resultRow As Long
    Dim tableStart As Integer
    Dim tableTot As Integer

    On Error Resume Next


    wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
    "Browse for file containing table to be imported")

    If wdFileName = False Then Exit Sub '(user cancelled import file browser)

    Set wdDoc = GetObject(wdFileName) 'open Word file

    With wdDoc
        tableNo = wdDoc.tables.count
        tableTot = wdDoc.tables.count
        If tableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf tableNo > 1 Then
            tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
            "Enter the table to start from", "Import Word Table", "1")
        End If

        resultRow = 4

        For tableStart = 1 To tableTot
            With .tables(tableStart)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.count
                    For iCol = 1 To .Columns.count
                        Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
                    Next iCol
                    resultRow = resultRow + 1
                Next iRow
            End With
            resultRow = resultRow + 1
        Next tableStart
    End With
End Sub

Answer 1

在找到最后一个空行时阅读Ron De Bruin's web site。

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    tableNo = wdDoc.tables.Count
    tableTot = wdDoc.tables.Count
    If tableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf tableNo > 1 Then
        tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
        "Enter the table to start from", "Import Word Table", "1")
    End If

    On Error Resume Next
    Rng = ActiveSheet.Range("A4").CurrentRegion
    resultRow = Rng.Find(What:="*", _
                    After:=Rng.Cells(1), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row + 1
    On Error GoTo 0
    If resultRow < 4 Then resultRow = 4

    For tableStart = 1 To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
                Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With

End Sub

将MS Word表从许多word文档导出到Excel工作表

1 个答案: