主题：如何将多个WORD文件合并在一个WORD文件上，保持原格式不变？

如何用代码将多个WORD文件合并在一个WORD文件上，保持原格式不变？

拷贝，粘贴不就行了？如代码

 

 

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("d:\test1.doc")
    Dim doc2 = wapp2.Documents.Open("d:\test2.doc")
    wapp2.ActiveWindow.Selection.WholeStory
    wapp2.ActiveWindow.Selection.copy
   
    wapp1.ActiveWindow.Selection.WholeStory
    wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
    wapp1.ActiveWindow.Selection.TypeParagraph
    wapp1.ActiveWindow.Selection.paste
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
   
end try

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
For Each file As String In filesys .GetFiles(ProjectPath & "文件夹")
    If file.EndsWith(".doc") Then
        try
            Dim doc1 = wapp1.Documents.Open("E:\合并表.doc")
            Dim doc2 = wapp2.Documents.Open(file)
            wapp2.ActiveWindow.Selection.WholeStory
            wapp2.ActiveWindow.Selection.copy
            wapp1.ActiveWindow.Selection.WholeStory
            wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
            wapp1.ActiveWindow.Selection.TypeParagraph
            wapp1.ActiveWindow.Selection.paste
            wapp2.Quit
            wapp1.Visible = True
        catch ex As exception
            msgbox(ex.message)
            wapp1.Quit
            wapp2.Quit
        finally
        End try
    End If
Next

如果文件夹中有多个WORD文件，应如何改？

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("E:\合并表.doc")
    For Each file As String In filesys .GetFiles(ProjectPath & "文件夹")
        If file.EndsWith(".doc") Then
            Dim doc2 = wapp2.Documents.Open(file)
            wapp2.ActiveWindow.Selection.WholeStory
            wapp2.ActiveWindow.Selection.copy
            wapp1.ActiveWindow.Selection.WholeStory
            wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
            wapp1.ActiveWindow.Selection.TypeParagraph
            wapp1.ActiveWindow.Selection.paste
           
        End If
    Next
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
End try

表1内容1.5页，表2内容1.6页，合并到合并表中表1占两页，表2占两页，共占4页，而不是3.1页？应如何改？

做不了。

用换页或添加空行不行吗？

参考代码，改成自己的。

 

Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
try
    Dim doc1 = wapp1.Documents.Open("d:\test1.doc")
    Dim doc2 = wapp2.Documents.Open("d:\test2.doc")
    wapp2.ActiveWindow.Selection.WholeStory
    wapp2.ActiveWindow.Selection.copy
   
    wapp1.ActiveWindow.Selection.WholeStory
    wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
   
    Dim pBreak = MSWord.WdBreakType.wdSectionBreakNextPage
    wapp1.ActiveWindow.Selection.InsertBreak(pBreak)
    wapp1.ActiveWindow.Selection.paste
    wapp2.Quit
    wapp1.Visible = True
catch ex As exception
    msgbox(ex.message)
    wapp1.Quit
    wapp2.Quit
finally
   
End try

第一页为空白页，应如何清除不要？

WORD如何加页脚？