寻找宏来将表标题/标题和每个表的内容从Word文档中提取到Excel

时间:2017-11-28 14:24:43

标签: excel vba excel-vba ms-word word-vba

我正在寻找一个宏来导出Word文档中每个表的内容,并将此内容移动到Excel。然而,除了拉动表的内容之外,我还希望导出每个表的标题。 Word文档的格式为内容样式表,其中包含"标题"这些表是目录中每个部分的标题。目录中的某些部分在该部分中没有表格,在这种情况下,如果其中没有表格,我希望宏从该部分继续。我试图让这个宏工作在一个文件夹中的多个Word文档。好消息是我已经有一个宏正在工作,除了拉出每个表格部分的标题之外我做了上面提到的所有事情。下面是我目前正在使用的宏。非常感谢任何帮助!!

Sub import_word_table_to_excel()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim fldpath
    Dim fld, fil As Object
    Dim appWord As Word.Application
    Dim docWord As Word.Document
    Dim tableWord As Word.Table
    Dim sdoc As String

    ' use to choose the folder having word documents
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
    Application.FileDialog(msoFileDialogFolderPicker).Show
    fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = fso.getfolder(fldpath)

    Set appWord = New Word.Application
    appWord.Visible = True
    For Each fil In fld.Files
        ' browse word documents in a folder
        If UCase(Right(fil.Path, 4)) = UCase(".doc") Or UCase(Right(fil.Path, 5)) = UCase(".docx") Then
            Set docWord = appWord.Documents.Open(fil.Path)
            For Each tableWord In docWord.Tables
                ' copy word tables
                tableWord.Range.Copy
                ' paste it on sheet 1 of excel file
                Sheets(1).Paste Destination:=Sheets(1).Range("A65356").End(xlUp).Offset(1, 0)
            Next

            docWord.Close
        End If
    Next fil

    appWord.Quit
    Sheets(1).Select
    Set tableWord = Nothing
    Set docWord = Nothing
    Set appWord = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

0 个答案:

没有答案