[文本处理] VBS合并WORD文件报错 求修改

qd2024

想用VBS 把\学生通知 目录下的所有DOCX文件合并为一个文件，静默后台处理，合并时不插入分页符，每个文件之前插入一下回车符 最后提示是否打印合并后的文件 如果选择是 则使用默认打印机打印文件 如选否 则打开合并后的文件

但是下面代码开始运行是就报错了
求老师 帮我改一下 谢谢
合并后的文件.docx   想改为  放在\学生通知下




链接：https://pan.baidu.com/s/13ZmeeyayO0M6eDRlTPW9GQ?pwd=5vdw
提取码：5vdw
--来自百度网盘超级会员V10的分享

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, "完成"
复制代码

czjt1234

32行改为
Set bDocOpened = objWord.Documents.Open(strDocName)
试试

或者
Set bDocOpened = objWord.Documents.Open(strDocName, , True)

qd2024

回复 2# czjt1234


    谢谢 不行提示找不到文件或文件损坏

hfxiang

回复 1# qd2024

试试这个工具：
https://bubianw.lanzoub.com/iVxfI137n5lg

Five66

32行那个
ReadOnly:=True
不是vbs的写法