批量将多份WORD表格的内容对应导入至EXCEL中

yuanjinboss

请求各位大师帮忙，
我现在有1000份固定格式的word文档，怎么将每份word表格内的内容导入到EXCEL对应单元格中。

约定的童话

Sub 提取()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i, n, F, Word, Myword As Object
    F = Dir(ThisWorkbook.Path & "\" & "*.docx")
    Set Word = VBA.CreateObject("word.application")
    i = 1
    Do While F <> ""
        Set Myword = Word.Documents.Open(ThisWorkbook.Path & "\" & F)
        Word.Visible = False
        k = Myword.Tables.Count
        For m = 2 To k Step 6
            i = i + 1
            ActiveSheet.Cells(i, 1) = i - 1 '序号
            ActiveSheet.Cells(i, 2) = Replace(Myword.Tables(m).cell(1, 2), "", "") '姓名
            ActiveSheet.Cells(i, 3) = Replace(Myword.Tables(m).cell(1, 4), "", "") '性别
            ActiveSheet.Cells(i, 4) = Replace(Myword.Tables(m).cell(1, 6), "", "") '年龄
            Myword.InlineShapes(i - 1).Select
            Word.Selection.Copy
            ActiveSheet.Cells(i, 5).Activate
            ActiveSheet.PasteSpecial Format:="图片(增强型图元文件)", Link:=False, DisplayAsIcon:=False
        Next
        Myword.Close False
        F = Dir
    Loop
    Word.Quit
    MsgBox "提取完毕！", , "报告！"
End Sub
word汇总案例，修改再用...

yuanjinboss

已解决，感谢