[VBS]去除WORD文档限制编辑

老刘

Usage
手动：选中Word文档拖拽到VBS文件上（支持拖拽多个）。
命令行：Cscript -nologo VBS路径 Word文档1 Word文档2 ...

[Visual Basic] 纯文本查看 复制代码

Rem Code By 老刘
Rem 转载请标明作者

Option Explicit
Const wdNewBlankDocument = 0 '空白新文档
Const wdFormatXMLDocument = 12 '.DOCX
Const wdFormatFlatXML = 19 '.XML

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim objXmlDom
Set objXmlDom = CreateObject("Microsoft.XMLDOM")
Dim objWord
On Error Resume Next
Set objWord = GetObject(,"Word.Application") '已有word运行则直接得到对象
If Err.Number <> 0 Then
        Err.Clear
        Set objWord = CreateObject("Word.Application")
        If Err.Number <> 0 Then
                If UCase(fso.GetBaseName(WScript.FullName)) = "CSCRIPT" Then
                        WScript.StdErr.WriteLine "老刘的温馨提示：Word的COM自动化组件无法创建！"
                Else
                        MsgBox "Word的COM自动化组件无法创建！",vbQuestion,"老刘的温馨提示"
                End If
                WScript.Quit 1
        End If
End If
On Error Goto 0

Dim objWordDocument,strArg,objXmlDocument,objProtecctionNodes,objProtecctionNode
For Each strArg In WScript.Arguments
        Rem 文档→XML。
        With objWord
                Set objWordDocument = fso.GetFile(strArg)
                .ChangeFileOpenDirectory objWordDocument.ParentFolder & "\"
                .Documents.Open objWordDocument.Name, False, True
                .ChangeFileOpenDirectory Fso.GetSpecialFolder(2) & "\"
                .ActiveDocument.SaveAs2 _
                        fso.GetBaseName(objWordDocument.Path)&".XML", _
                        wdFormatFlatXML
                .ActiveDocument.Close
                Set objXmlDocument = _
                        fso.GetFile( _
                        fso.GetSpecialFolder(2) & "\" & _
                        fso.GetBaseName(objWordDocument.Path) & ".XML" _
                        )
        End With
        
        Rem 去除w:documentProtection节点。
        With objXmlDom
                .load objXmlDocument.Path
                Set objProtecctionNodes = .getElementsByTagName("w:documentProtection")
                If objProtecctionNodes.length = 0 Then
                        If UCase(fso.GetBaseName(WScript.FullName)) = "CSCRIPT" Then
                                WScript.StdErr.WriteLine objWordDocument.Name&" 未被限制编辑"
                        End If
                Else
                        For Each objProtecctionNode In objProtecctionNodes
                                objProtecctionNode.parentNode.removeChild(objProtecctionNode)
                        Next
                End If
                .save objXmlDocument.Path
                .abort
        End With
        
        Rem XML→DOCX。
        With objWord
                .Documents.Open objXmlDocument.Name
                .ChangeFileOpenDirectory objWordDocument.ParentFolder & "\"
                .ActiveDocument.SaveAs2 _
                        "[Unlocked]"&fso.GetBaseName(objWordDocument.Path)&".DOCX", _
                        wdFormatXMLDocument
                .ActiveDocument.Close
                objXmlDocument.Delete True
        End With
Next

objWord.Visible = True
Set fso = Nothing
Set objXmlDom = Nothing
Set objWord = Nothing '该操作不会关闭Word
WScript.Echo "老刘的提醒：由于要保证处理速度（开关WORD太费时），不使用时请手动退出WORD。"

老刘

myqqq 发表于 2019-10-30 20:26
把文件拖拽到VBS就这样啊，没反应

已经将解锁完的文件放到同一目录了
代码执行完成界面才显示的

andy90

出错了，怎么解决，老大。

找到问题所在了，记事本另存为vbs时要把右下角的编码选为ANSI。
已经可以正常使用了，谢谢老大。
试过，可以去除word2016格式docx文档的限制编辑。

御剑行

用的上的感觉很不错

cdwdz

楼主不能继续整理整理 做成软件吗   小白看了发憷哦

老刘

cdwdz 发表于 2019-10-30 12:41
楼主不能继续整理整理 做成软件吗   小白看了发憷哦

直接保存为VBS就可以用了呀

myqqq

把文件拖拽到VBS就这样啊，没反应

ISHAO

我放上去报错呀，错误是vbscript编译器错误，未结束的字符串常量，是为啥呢

老刘

ISHAO 发表于 2019-11-7 19:33
我放上去报错呀，错误是vbscript编译器错误，未结束的字符串常量，是为啥呢

emm，你可以做以下检查
1、word（微软的）是否正常安装
2、vbs保存时候的编码是不是ANSI（记事本另存为的时候可以选）

hyshen

学习了，老刘的代码很规整，看起来舒服。

ISHAO

老刘 发表于 2019-11-7 22:09
emm，你可以做以下检查
1、word（微软的或WPS）是否正常安装
2、vbs保存时候的编码是不是ANSI（记事本 ...

好的，谢谢了