求高手帮忙将如何把多个word文档中数据 提取到Excel表格

344046229

求高手帮忙将如何把多个word文档中数据 提取到Excel表格
不胜感激涕零！

344046229

182197315 发表于 2019-11-12 13:16
提取的内容有点多，要花时间写。
不过提示一下，楼上说的没错，跟第几页没关系，你搞清楚是第几个表第几行 ...

谢谢前辈指导,代码后面怎么采集不了，怎么代码有变化，采集显示内容有重复问题，变量怎么写啊谢谢方便指导一下么，到第二页第三页

Sub 提取数据()
    On Error Resume Next
    n = 1
    Set doc = CreateObject("word.application")
    f = Dir(ThisWorkbook.Path & "\*.doc")
    Do While f <> ""
        n = n + 1
        Set wd = doc.Documents.Open(ThisWorkbook.Path & "\" & f)
        doc.Visible = True
        With doc.Documents(1).Tables(1)
            Cells(n, 1) = l(.Cell(1, 2).Range) '姓名
            Cells(n, 2) = l(.Cell(2, 2).Range) '政治面貌
            Cells(n, 3) = l(.Cell(3, 2).Range) '参加工作时间
            Cells(n, 4) = l(.Cell(4, 2).Range) '现资格等级
            Cells(n, 5) = l(.Cell(5, 2).Range) '身份证号码
            Cells(n, 6) = l(.Cell(6, 2).Range) '联系电话
            Cells(n, 7) = l(.Cell(6, 4).Range) '学历培训起止年月
            Cells(n, 8) = l(.Cell(9, 1).Range) '何校、何单位进行何种学习
            Cells(n, 9) = l(.Cell(9, 2).Range) '参加工作时间
            Cells(n, 10) = l(.Cell(11, 1).Range) '工作经历
            Cells(n, 11) = l(.Cell(11, 2).Range) '
            Cells(n, 12) = l(.Cell(15, 2).Range) '
            
            
        End With
        f = Dir
        wd.Close False
    Loop
    doc.Quit
    MsgBox "完成！"
End Sub
Function l(a)
    l = WorksheetFunction.Clean(a) '清除换行符，否则读取出来会有一个小黑点或者小方块
End Function

小花鹿

论坛有类似的例子，搜索一下吧                                                                                          

344046229

小花鹿 发表于 2019-11-10 21:57
论坛有类似的例子，搜索一下吧                                                                         ...

谢谢建议，搜索看了很多研究了一下，不过基本上只能提取第一页的，第一页以后的代码调整后不行

changhong8

两个变量，一个是第几个表格，另外一个是表格的行列索引

182197315

提取的内容有点多，要花时间写。
不过提示一下，楼上说的没错，跟第几页没关系，你搞清楚是第几个表第几行第几列就OK

layamon

谢谢