求助各位都是，如何把多个WORD文档合并到一个文件中。

david_jiao

各位老师：
急求各位老师指点，如何用VBA把一个文件夹下的部分WORD文件合并到一个新的WORD文档中，要求把每个文件的页眉也一并带过来。
感谢老师的帮助。在线等！

413191246se

楼主：1、部分 Word 文件 什么意思？2、刚才我测试发现，只要在文件间插入分节符，各个文档的页眉自然会保留的。

david_jiao

413191246se 发表于 2021-2-2 11:07
楼主：1、部分 Word 文件 什么意思？2、刚才我测试发现，只要在文件间插入分节符，各个文档的页眉自然会保 ...

谢谢老师，你做的就是了，我说的部分文档是指可以手动选择需要合并的WORD文档，也可以是全部。谢谢您！辛苦了！

david_jiao

david_jiao 发表于 2021-2-2 14:54
谢谢老师，你做的就是了，我说的部分文档是指可以手动选择需要合并的WORD文档，也可以是全部。谢谢您！辛 ...

老师您可以把您的代码分享给学生吗？谢谢！

413191246se

楼主，我经过尝试，发现如果手动选择文件插入新文档中的话，一次性就合并完成了，但文档之间没有分节符，弄不清哪些文字是哪个文档的；建议如果坚持想手动选择文档的话，请先右键将其压缩到 D 盘的一个新文件夹中，再进行合并就可以了。但我现在对 dir 函数 不大会，想来轻量级的合并，稍有些困难，并且合并时可能无法顾及到合并顺序。

413191246se

* 楼主，如果要手动选择文件的话，请右键 WinRAR 打包到某盘，解压到文件夹中，再应用宏（执行宏后会询问打开哪个文件夹，只要找到要合并的文件夹即可确定）。
* 如果想选择某个文件夹（可以包含子文件夹）下的所有文件合并的话，请试用由 杜老师（duquancai）编写的《循环遍历文件夹及子文件夹》宏完成你的任务。
* 请注意备份原文件。

1. Sub TextJoint_LoopFolder_duquancai()
   
2.     Dim pPath$, f As Object, fd As Object, fso As Object, Stack$(), top&, n&, stxt$, doc As Document, x&
   
3.     pPath = SelectFolder
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     top = 1
   
6.     ReDim Stack(0 To top)
   
7.     Documents.Add
   
8.     Dim InsFileName$
   
9.     Do While top >= 1
   
10.         For Each f In fso.getfolder(pPath).Files
    
11.             n = n + 1
    
12.             stxt = f.Path
    
13.             If stxt Like "*.doc*" Then
    
14.                 Set doc = Documents.Open(FileName:=stxt)
    
15.                 InsFileName = doc.FullName
    
16.                 doc.Close SaveChanges:=wdSaveChanges
    
17.                 Selection.InsertFile FileName:=InsFileName
    
18.                 Selection.InsertBreak Type:=wdSectionBreakNextPage
    
19.                 x = x + 1
    
20.             End If
    
21.         Next
    
22.         For Each fd In fso.getfolder(pPath).SubFolders
    
23.             Stack(top) = fd.Path
    
24.             top = top + 1
    
25.             If top > UBound(Stack) Then ReDim Preserve Stack(0 To top)
    
26.         Next
    
27.         If top > 0 Then pPath = Stack(top - 1): top = top - 1
    
28.     Loop
    
29.     Set f = Nothing
    
30.     Set fd = Nothing
    
31.     Set fso = Nothing
    
32.     MsgBox "File not saved! Processed Files = " & n & vbCr & "Total Files(*.docx/*.doc) = " & x, 0 + 16
    
33. End Sub
    
34. Function SelectFolder() As String
    
35.     With Application.FileDialog(msoFileDialogFolderPicker)
    
36.         If .Show Then SelectFolder = .SelectedItems(1) & "" Else End
    
37.     End With
    
38.     If MsgBox("Are you sure ? " & """" & SelectFolder & """", 4 + 16) = vbNo Then End
    
39. End Function

复制代码

david_jiao

413191246se 发表于 2021-2-3 02:39
* 楼主，如果要手动选择文件的话，请右键 WinRAR 打包到某盘，解压到文件夹中，再应用宏（执行宏后会询问打 ...

谢谢，这个也可以，谢谢老师！