Dim wapp1 As New MSWord.Application
Dim wapp2 As New MSWord.Application
Dim wapp3 As New MSExcel.Application
try
'新建一个Word接收文档
Dim missing = System.Reflection.Missing.Value
Dim doc1 = wapp1.Documents.Add(missing, missing, missing, missing)
Dim str() As String = {"12.docx","34.docx","123.xlsx"}
Dim bb As Integer
For Each s As String In str
wapp1.ActiveWindow.Selection.WholeStory
wapp1.ActiveWindow.Selection.MoveRight(Unit:=1, Count:=1)
'在文件后插入分页符
If bb > 0 Then
Dim pBreak = MSWord.WdBreakType.wdSectionBreakNextPage
wapp1.ActiveWindow.Selection.InsertBreak(pBreak)
End If
If s.EndsWith(".doc") OrElse s.EndsWith(".docx") Then '如果是doc文件
Dim doc2 = wapp2.Documents.Open(ProjectPath & s)
wapp2.ActiveWindow.Selection.WholeStory
wapp2.ActiveWindow.Selection.copy
wapp1.ActiveWindow.Selection.paste
ElseIf s.EndsWith(".xls") OrElse s.EndsWith( ".xlsx") Then '如果是xls文件
Dim Wb As MSExcel.WorkBook = wapp3 .WorkBooks.Open(ProjectPath & s)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) '指定要复制的工作表
Ws.UsedRange.Copy
wapp1.ActiveWindow.Selection.TypeParagraph
wapp1.ActiveWindow.Selection.paste
End If
bb+= 1
Next
Dim nm As String = Format(Date.Now, "yyyyMMddhhmmss")
doc1.SaveAs(ProjectPath & "Word合并\" & nm & ".docx")
wapp1.Visible = True
catch ex As exception
msgbox(ex.message)
finally
wapp2.Quit
wapp3.Quit
End try
加好友 
发短信
Post By：2019/10/21 22:21:00 [只看该作者]
