如何从多个WORD文件中提取相应的文字和数值到EXCEL里

182197315 · 发表于 2016-12-1 18:59

这是附件，请试用。

Death123 · 发表于 2016-12-5 13:09

本帖最后由 Death123 于 2016-12-5 14:55 编辑

182197315 发表于 2016-12-1 18:59
这是附件，请试用。

很好用，谢谢！非常感谢！

Death123 · 发表于 2016-12-7 15:32

182197315 发表于 2016-12-1 18:59
这是附件，请试用。

大神，如果中间夹杂几个格式不一样的doc，会报错停止，数据不会保存，可以不可以自动跳过那些提取不出来的？

182197315 · 发表于 2016-12-7 20:30

本帖最后由 182197315 于 2016-12-7 20:38 编辑

程序里加一句代码
On Error Resume Next

Sub 提取信息()
Range("A1").CurrentRegion.Offset(1, 0).ClearContents
Cells.Borders.LineStyle = xlNone
Application.ScreenUpdating = False
Dim wordD As Word.Document
Dim wordapp As Object
Dim cPath$, cFile$, i%, arr()
cPath = ThisWorkbook.Path & "\"
cFile = Dir(cPath & "*.doc?")
Set wordapp = CreateObject("word.Application")
Do While cFile <> ""
      Set wordD = wordapp.Documents.Open(cPath & cFile)
      i = i + 1
      ReDim Preserve arr(1 To 4, 1 To i)
      With wordD
         arr(1, i) = Replace(Replace(.Paragraphs(18).Range.Text, Chr(7), ""), Chr(13), "")
         arr(3, i) = Replace(Replace(.Paragraphs(20).Range.Text, Chr(7), ""), Chr(13), "")
         arr(2, i) = Replace(Replace(.Paragraphs(44).Range.Text, Chr(7), ""), Chr(13), "")
         arr(4, i) = Replace(Replace(.Paragraphs(82).Range.Text, Chr(7), ""), Chr(13), "")
      End With
      wordD.Close
      cFile = Dir
Loop
Set wordD = Nothing
wordapp.Quit
Range("a2").Resize(i, 4).Value = Application.Transpose(arr)
Range("A1:D" & i + 1).Borders.LineStyle = xlContinuous
Application.ScreenUpdating = True
End Sub

182197315 · 发表于 2016-12-7 20:44

顺便提一句，你的Word文档有table表格，但代码通过cell的方法写，居然不行。
写成类似arr(1, i) = Replace(Replace(.Cell(2, 1).Range.Text, Chr(7), ""), Chr(13), "")提示错误。
而写成arr(1, i) = Replace(Replace(.Paragraphs(18).Range.Text, Chr(7), ""), Chr(13), "")是对的。

请知道的老师回答

kszcs · 发表于 2016-12-8 07:12

182197315 发表于 2016-12-7 20:44
顺便提一句，你的Word文档有table表格，但代码通过cell的方法写，居然不行。
写成类似arr(1, i) = Replace ...

182197315你好
提示找不到工程库，

182197315 · 发表于 2016-12-8 18:18

kszcs 发表于 2016-12-8 07:12
182197315你好
提示找不到工程库，

请看图片，请引用以下选项。

duquancai · 发表于 2016-12-8 18:39

182197315 发表于 2016-12-7 20:44
顺便提一句，你的Word文档有table表格，但代码通过cell的方法写，居然不行。
写成类似arr(1, i) = Replace ...

代码写的这么漂亮，还需要指点吗？

182197315 · 发表于 2016-12-8 18:46

duquancai 发表于 2016-12-8 18:39
代码写的这么漂亮，还需要指点吗？

老师，我就是不明白，Word文档中有table为什么不能通过cell提取有关内容

cbi007 · 发表于 2018-3-23 23:15

标记一下！！！

		自动登录	找回密码
密码			免费注册

[求助] 如何从多个WORD文件中提取相应的文字和数值到EXCEL里