Option Explicit

Const strFolder = ".\学生通知"
Const strDocToMerge = ".\合并后的文件.docx"

Dim objWord, objDoc, objSelection
Dim strFile, strDocName
Dim objFSO, objFolder, objFiles
Dim bDocOpened

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(strFolder) Then
    MsgBox "文件夹不存在: " & strFolder, vbExclamation, "错误"
    WScript.Quit
End If

Set objFolder = objFSO.GetFolder(strFolder)
Set objFiles = objFolder.Files

Set objWord = CreateObject("Word.Application")
objWord.Visible = False

Set objDoc = objWord.Documents.Add
Set objSelection = objWord.Selection

For Each strFile In objFiles
    strDocName = strFolder & "\" & strFile.Name
    If LCase(objFSO.GetExtensionName(strFile.Name)) = "docx" Then
        If objFSO.FileExists(strDocName) Then
            On Error Resume Next
            Set bDocOpened = objWord.Documents.Open(strDocName, ReadOnly:=True)
            If Err.Number <> 0 Then
                MsgBox "无法打开文件: " & strDocName & vbCrLf & "错误: " & Err.Description, vbExclamation, "错误"
                Err.Clear
                On Error GoTo 0
                ' 不再使用 Continue For，而是直接跳到下一次循环
            Else
                On Error GoTo 0
                objSelection.WholeStory
                objSelection.Copy
                objDoc.Activate
                objSelection.Paste
                objSelection.TypeParagraph ' 插入回车符
                bDocOpened.Close False
            End If
        End If
    End If
Next

objDoc.SaveAs strDocToMerge
objDoc.Close

Dim intMsgBox
intMsgBox = MsgBox("是否打印合并后的文件？", vbYesNo + vbQuestion, "打印文档")

If intMsgBox = vbYes Then
    Set objDoc = objWord.Documents.Open(strDocToMerge)
    objDoc.PrintOut
    objDoc.Close
Else
    objWord.Visible = True
    Set objDoc = objWord.Documents.Open(strDocToMerge)
End If

Set objSelection = Nothing
Set objDoc = Nothing
Set objWord = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

MsgBox "处理完成。", vbInformation, "完成"
复制代码