[已解决]求助 如何将一个文件夹下面的word按顺序黏贴在一个word中

ddhhyy16

按照0101  0102   0103.。。。。。。。。。。。。。。。。的顺序将文件夹中的word粘贴在一个word里面~~~
谢谢了

最佳答案

月排行榜 / 总排行榜

wp8680

2015-4-14 12:53

1. Sub 合并()    '从不打开的工作簿里提取数据
   
2.     Dim Wb As Document
   
3.     Dim MyPth As String    '定义MyPth为文本型变量
   
4.     Dim ph1 As String
   
5.    
   
6.     MsgBox "本次操作将会合并本文档同一文件夹下的所有“.doc”后缀名的文件！"
   
7.     '    Application.ScreenUpdating = False    '关闭屏幕刷新
   
8.     Selection.WholeStory
   
9.     '清除原来存在的文字
   
10.     Selection.Delete Unit:=wdCharacter, Count:=1
    
11.    
    
12.     MyPth = ThisDocument.Path & ""    '把数据源工作簿路径赋给MyPth
    
13.     ph1 = Dir(MyPth & "*.doc")
    
14.     Do
    
15.         If ph1 <> ThisDocument.Name Then
    
16.             Set Wb = GetObject(MyPth & ph1)    '把返回路径上的文件引用且赋值给Wb
    
17.             Wb.Range.Copy
    
18.             Windows("合并文档.doc").Activate
    
19.             Selection.PasteAndFormat (wdPasteDefault)
    
20.             Wb.Close False    '关才Wb工作簿，且不保存更改
    
21.             Set Wb = Nothing    '释放内存
    
22.         End If
    
23.         ph1 = Dir
    
24.     Loop While ph1 <> ""
    
25. 
    
26.     '    Application.ScreenUpdating = True    '打开屏幕刷新
    
27. End Sub

复制代码

跳转到最佳答案楼层

wp8680

1. Sub 合并()    '从不打开的工作簿里提取数据
   
2.     Dim Wb As Document
   
3.     Dim MyPth As String    '定义MyPth为文本型变量
   
4.     Dim ph1 As String
   
5.    
   
6.     MsgBox "本次操作将会合并本文档同一文件夹下的所有“.doc”后缀名的文件！"
   
7.     '    Application.ScreenUpdating = False    '关闭屏幕刷新
   
8.     Selection.WholeStory
   
9.     '清除原来存在的文字
   
10.     Selection.Delete Unit:=wdCharacter, Count:=1
    
11.    
    
12.     MyPth = ThisDocument.Path & ""    '把数据源工作簿路径赋给MyPth
    
13.     ph1 = Dir(MyPth & "*.doc")
    
14.     Do
    
15.         If ph1 <> ThisDocument.Name Then
    
16.             Set Wb = GetObject(MyPth & ph1)    '把返回路径上的文件引用且赋值给Wb
    
17.             Wb.Range.Copy
    
18.             Windows("合并文档.doc").Activate
    
19.             Selection.PasteAndFormat (wdPasteDefault)
    
20.             Wb.Close False    '关才Wb工作簿，且不保存更改
    
21.             Set Wb = Nothing    '释放内存
    
22.         End If
    
23.         ph1 = Dir
    
24.     Loop While ph1 <> ""
    
25. 
    
26.     '    Application.ScreenUpdating = True    '打开屏幕刷新
    
27. End Sub

复制代码

wp8680

第01章 总论.part2.rar (1.45 MB, 下载次数: 20)

2015-4-14 13:09 上传

点击文件名下载附件 第01章 总论.part1.rar (2 MB, 下载次数: 21)

2015-4-14 13:09 上传

点击文件名下载附件