怎么使用vba批量提取word

1.怎么是用VBA批量提取word文档指定内容到Excel?

Sub abc()

Dim App, WrdDoc, MyPath, MyFile, BM, Str

Mypath = "文件实际路径\*.doc" '请修改实际储存路径！

Set App = CreateObject("Word.Application") '用Set关键字创建Word应用成序对象！

MyFile = Dir(Mypath) ' 获得第一个WORD文档

do while MyFile "" ' 遍历Mypath下面的所有WORD文档

App.Visible = True

Set WrdDoc = App.Documents.Open(MyFile) '打开这个Word文件！

for each BM in WrdDoc.Bookmarks ' 遍历文档中的所有书签

Str = BM.Range ' 读取书签内容

next BM

WrdDoc.Close ' 关闭文件

MyFile = Dir ' 下一个WORD文档

Loop

Set App = Nothing

End Sub

2.如何用VBA宏程序将excel中的内容批量复制到word文档中去

抱歉，没有实际调试代码

DIR函数只返回文件名，不包含完整路径

所以请重新修改为以下代码：

Sub abc()

Dim App, WrdDoc, MyPath, MyFile, BM, Str

Mypath = "文件实际路径" '请修改实际储存路径！

Set App = CreateObject("Word.Application") '用Set关键字创建Word应用成序对象！

MyFile = Dir(Mypath & "\*.doc") ' 获得第一个WORD文档

do while MyFile <>； "" ' 遍历Mypath下面的所有WORD文档

App.Visible = True

Set WrdDoc = App.Documents.Open(Mypath & "\" & MyFile) '打开这个Word文件！

for each BM in WrdDoc.Bookmarks ' 遍历文档中的所有书签

Str = BM.Range ' 读取书签内容

next BM

WrdDoc.Close ' 关闭文件

MyFile = Dir ' 下一个WORD文档

Loop

Set App = Nothing

End Sub

3.Excel VBA如何按文件的最新日期提取文件

首先呢，得获取所有文件名称，然后呢，根据文件名称年月日部分挑出最新日期，再然后呢，根据最新日期生成文件名，再然后呢，进行复制。

注：你的源数据文件名和目录结构应该如图 样本文件见附件 代码如下 Sub test()Dim pth As String, fn As String, ary(), tmpMax As Long, i As IntegerDim wb As Workbookpth = "D:\data\" '设置路径fn = Dir(pth & "*.xlsx") '遍历该路径下的.xlsx文件i = 0: tmpMax = 0Do While fn <> "" If fn <> ThisWorkbook.Name Then i = i + 1 ReDim Preserve ary(i) '声明动态数组，在数组后面追加元素 ary(i) = --Left(Right(fn, 13), 8） '假设文件名称形式为“namelist20140918.xlsx”这样的格式，将年月日8位数装入数组 If ary(i) > tmpMax Then tmpMax = ary(i) '不断将找到的最大日期值放入变量tmpmax End If fn = DirLoopSet wb = Workbooks.Open(pth & "namelist" & tmpMax & ".xlsx", , True) '打开tmpmax指定的文件wb.Worksheets("Sheet2").Cells.Copy ThisWorkbook.Worksheets("Sheet3").Cells '复制目标相关内容wb.CloseEnd Sub。