利用Excel的VBA提取word中的数据，部分非表格

weizxh

约定的童话 发表于 2019-3-20 17:45
这题着实困难啊，序号跟建档时间没法弄，其他的都可以提取出来

感谢各位大佬的无私帮助，谢谢你们

mzbao

weizxh 发表于 2019-3-21 10:12
感谢大佬的技术分享，不过代码的简洁程度没有上面大佬的直观。  依然感谢无私帮助我的人

这个简洁了吧。。。。。。。

1. Sub ReadFromWord()
   
2.     Dim oDoc As Object
   
3.     Dim myPath$, MyName$, k%, JDDate$
   
4.    
   
5.     Range("A2:F2000").ClearContents
   
6.     myPath = ThisWorkbook.Path & ""
   
7.     MyName = Dir(myPath & "*.doc*")
   
8.     k = 1
   
9.     Do While MyName <> ""
   
10.         If InStr(1, MyName, "农户信用(经济)档案") Then
    
11.             Set oDoc = GetObject(myPath & MyName)
    
12.             k = k + 1
    
13.             Cells(k, 1) = k - 1
    
14.             With oDoc.Tables(1)
    
15.                 Cells(k, 2) = Replace(.Cell(3, 2).Range.Text, Chr(7), "")
    
16.                 Cells(k, 3) = Replace(.Cell(3, 6).Range.Text, Chr(7), "")
    
17.                 Cells(k, 4) = Replace(.Cell(6, 2).Range.Text, Chr(7), "")
    
18.                 Cells(k, 6) = Replace(.Cell(7, 2).Range.Text, Chr(7), "")
    
19.             End With
    
20.             JDDate = oDoc.Paragraphs(3).Range.Text
    
21.             JDDate = Split(Split(JDDate, " ")(0), "：")(1)
    
22.             Cells(k, 5) = JDDate
    
23.                
    
24.             oDoc.Close True
    
25.         End If
    
26.         MyName = Dir
    
27.     Loop
    
28.    
    
29. End Sub

复制代码

注意myPath = ThisWorkbook.Path & "\"后面的"\"被网站自动删除了，需要手动加上。

weizxh

mzbao 发表于 2019-3-21 10:23
这个简洁了吧。。。。。。。

注意myPath = ThisWorkbook.Path & "\"后面的"\"被网站自动删除了，需要 ...

大佬，你这个更牛，日期都读取出来了

weizxh

mzbao 发表于 2019-3-21 10:23
这个简洁了吧。。。。。。。

注意myPath = ThisWorkbook.Path & "\"后面的"\"被网站自动删除了，需要 ...

能留个联系方式么，有些代码看不懂。如果相当能的文档变化了的话，希望能自己做适当的修改就可以用了，希望你得到你的指点

mzbao

weizxh 发表于 2019-3-21 10:43
能留个联系方式么，有些代码看不懂。如果相当能的文档变化了的话，希望能自己做适当的修改就可以用了，希 ...

到时候你再发帖就是了，或者直接在这里面回复也行。就算我没看到，也有其他人会帮忙。

mhps159357

weizxh 发表于 2019-3-21 09:09
我用的是office2003，怎么引入呢？

在代码框中   点击  工具——引用   你的应该是Microsoft word  11.0 object  library

weizxh

mzbao 发表于 2019-3-21 10:49
到时候你再发帖就是了，或者直接在这里面回复也行。就算我没看到，也有其他人会帮忙。

好的，谢谢大佬。  我看了下，这段代码
JDDate = oDoc.Paragraphs(3).Range.Text
            JDDate = Split(Split(JDDate, " ")(0), "：")(1)
第一句应该是读取文档的第3行，第二句应该是转换日期。
但我试着修改了下日期的位置的话，就不能读取了，如果表格有变化，应该怎么修改来适应新的文档呢

mzbao

weizxh 发表于 2019-3-21 11:04
好的，谢谢大佬。  我看了下，这段代码
JDDate = oDoc.Paragraphs(3).Range.Text
            JDDate = ...

第一行是读取第3段的内容。因为你附件里Word文档的日期全部在第三段。

mzbao

weizxh 发表于 2019-3-21 11:04
好的，谢谢大佬。  我看了下，这段代码
JDDate = oDoc.Paragraphs(3).Range.Text
            JDDate = ...

你把读取日期的部分改成以下代码，可能会好些，免得有人在日期前面多输入个空格，前面的代码就读不到了。

1. JDDate = oDoc.Paragraphs(3).Range.Text
   
2.             JDDate = Split(Split(JDDate, "建档")(1), "：")(1)
   
3.             JDDate = Trim(JDDate)
   
4.             Cells(k, 5) = JDDate

复制代码

weizxh

mzbao 发表于 2019-3-21 11:12
你把读取日期的部分改成以下代码，可能会好些，免得有人在日期前面多输入个空格，前面的代码就读不到了。 ...

好的，谢谢。  先用着吧，如果有问题再来咨询各位大佬