VBS合并WORD文件报错 求修改

qd2024

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

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




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

1. Option Explicit
   
2. 
   
3. Const strFolder = ".\学生通知"
   
4. Const strDocToMerge = ".\合并后的文件.docx"
   
5. 
   
6. Dim objWord, objDoc, objSelection
   
7. Dim strFile, strDocName
   
8. Dim objFSO, objFolder, objFiles
   
9. Dim bDocOpened
   
10. 
    
11. Set objFSO = CreateObject("Scripting.FileSystemObject")
    
12. 
    
13. If Not objFSO.FolderExists(strFolder) Then
    
14.     MsgBox "文件夹不存在: " & strFolder, vbExclamation, "错误"
    
15.     WScript.Quit
    
16. End If
    
17. 
    
18. Set objFolder = objFSO.GetFolder(strFolder)
    
19. Set objFiles = objFolder.Files
    
20. 
    
21. Set objWord = CreateObject("Word.Application")
    
22. objWord.Visible = False
    
23. 
    
24. Set objDoc = objWord.Documents.Add
    
25. Set objSelection = objWord.Selection
    
26. 
    
27. For Each strFile In objFiles
    
28.     strDocName = strFolder & "" & strFile.Name
    
29.     If LCase(objFSO.GetExtensionName(strFile.Name)) = "docx" Then
    
30.         If objFSO.FileExists(strDocName) Then
    
31.             On Error Resume Next
    
32.             Set bDocOpened = objWord.Documents.Open(strDocName, ReadOnly:=True)
    
33.             If Err.Number <> 0 Then
    
34.                 MsgBox "无法打开文件: " & strDocName & vbCrLf & "错误: " & Err.Description, vbExclamation, "错误"
    
35.                 Err.Clear
    
36.                 On Error GoTo 0
    
37.                 ' 不再使用 Continue For，而是直接跳到下一次循环
    
38.             Else
    
39.                 On Error GoTo 0
    
40.                 objSelection.WholeStory
    
41.                 objSelection.Copy
    
42.                 objDoc.Activate
    
43.                 objSelection.Paste
    
44.                 objSelection.TypeParagraph ' 插入回车符
    
45.                 bDocOpened.Close False
    
46.             End If
    
47.         End If
    
48.     End If
    
49. Next
    
50. 
    
51. objDoc.SaveAs strDocToMerge
    
52. objDoc.Close
    
53. 
    
54. Dim intMsgBox
    
55. intMsgBox = MsgBox("是否打印合并后的文件？", vbYesNo + vbQuestion, "打印文档")
    
56. 
    
57. If intMsgBox = vbYes Then
    
58.     Set objDoc = objWord.Documents.Open(strDocToMerge)
    
59.     objDoc.PrintOut
    
60.     objDoc.Close
    
61. Else
    
62.     objWord.Visible = True
    
63.     Set objDoc = objWord.Documents.Open(strDocToMerge)
    
64. End If
    
65. 
    
66. Set objSelection = Nothing
    
67. Set objDoc = Nothing
    
68. Set objWord = Nothing
    
69. Set objFiles = Nothing
    
70. Set objFolder = Nothing
    
71. Set objFSO = Nothing
    
72. 
    
73. 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的写法