Board logo

标题: [文本处理] VBS合并WORD文件报错 求修改 [打印本页]

作者: qd2024    时间: 2024-3-15 08:30     标题: VBS合并WORD文件报错 求修改

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

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




链接:https://pan.baidu.com/s/13ZmeeyayO0M6eDRlTPW9GQ?pwd=5vdw
提取码:5vdw
--来自百度网盘超级会员V10的分享
  1. Option Explicit
  2. Const strFolder = ".\学生通知"
  3. Const strDocToMerge = ".\合并后的文件.docx"
  4. Dim objWord, objDoc, objSelection
  5. Dim strFile, strDocName
  6. Dim objFSO, objFolder, objFiles
  7. Dim bDocOpened
  8. Set objFSO = CreateObject("Scripting.FileSystemObject")
  9. If Not objFSO.FolderExists(strFolder) Then
  10.     MsgBox "文件夹不存在: " & strFolder, vbExclamation, "错误"
  11.     WScript.Quit
  12. End If
  13. Set objFolder = objFSO.GetFolder(strFolder)
  14. Set objFiles = objFolder.Files
  15. Set objWord = CreateObject("Word.Application")
  16. objWord.Visible = False
  17. Set objDoc = objWord.Documents.Add
  18. Set objSelection = objWord.Selection
  19. For Each strFile In objFiles
  20.     strDocName = strFolder & "\" & strFile.Name
  21.     If LCase(objFSO.GetExtensionName(strFile.Name)) = "docx" Then
  22.         If objFSO.FileExists(strDocName) Then
  23.             On Error Resume Next
  24.             Set bDocOpened = objWord.Documents.Open(strDocName, ReadOnly:=True)
  25.             If Err.Number <> 0 Then
  26.                 MsgBox "无法打开文件: " & strDocName & vbCrLf & "错误: " & Err.Description, vbExclamation, "错误"
  27.                 Err.Clear
  28.                 On Error GoTo 0
  29.                 ' 不再使用 Continue For,而是直接跳到下一次循环
  30.             Else
  31.                 On Error GoTo 0
  32.                 objSelection.WholeStory
  33.                 objSelection.Copy
  34.                 objDoc.Activate
  35.                 objSelection.Paste
  36.                 objSelection.TypeParagraph ' 插入回车符
  37.                 bDocOpened.Close False
  38.             End If
  39.         End If
  40.     End If
  41. Next
  42. objDoc.SaveAs strDocToMerge
  43. objDoc.Close
  44. Dim intMsgBox
  45. intMsgBox = MsgBox("是否打印合并后的文件?", vbYesNo + vbQuestion, "打印文档")
  46. If intMsgBox = vbYes Then
  47.     Set objDoc = objWord.Documents.Open(strDocToMerge)
  48.     objDoc.PrintOut
  49.     objDoc.Close
  50. Else
  51.     objWord.Visible = True
  52.     Set objDoc = objWord.Documents.Open(strDocToMerge)
  53. End If
  54. Set objSelection = Nothing
  55. Set objDoc = Nothing
  56. Set objWord = Nothing
  57. Set objFiles = Nothing
  58. Set objFolder = Nothing
  59. Set objFSO = Nothing
  60. MsgBox "处理完成。", vbInformation, "完成"
复制代码

作者: czjt1234    时间: 2024-3-15 16:56

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

或者
Set bDocOpened = objWord.Documents.Open(strDocName, , True)
作者: qd2024    时间: 2024-3-15 17:15

回复 2# czjt1234


    谢谢 不行提示找不到文件或文件损坏
作者: hfxiang    时间: 2024-4-15 10:48

回复 1# qd2024

试试这个工具:
https://bubianw.lanzoub.com/iVxfI137n5lg
作者: Five66    时间: 2024-4-15 17:27

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




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2