作者:乔山办公网日期:
返回目录:excel表格制作
可以完成。但要说如何完成,那就不是几句话能说清了。
Sub abc()
Dim App, WrdDoc, MyPath, MyFile, BM, Str
Mypath = "文件实际路zhidao径\*.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
试试下面的代e799bee5baa6e59b9ee7ad94338码:
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% '定义找到的字段的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
Set wdRng = mydoc.Range
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy '选中找到的两个字段中间的内容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub