如何批量取消word密码？VBA简单编程解决

前些日子碰到一个问题，接手到一批资料。全部都是加密了的word文档，还好密码是统一的。这些资料是要上传到平台上共享的，总不能说还要备注说密码是多少，而且和平台上其他不加密的文件放在一起，有的是加密的，有的又是不加密的，多影响用户体验，你说是不是。

难道我们要一个一个打开，然后选项-文档保护-取消密码...？答案当然是NO。写这一篇文章主要是因为网上并没有很完善的解决方案，或者是方案过于久远，对于目前的系统和软件版本来说已经不适用。可能用到的场景不多，但是万一遇到了呢？所以还是写出来作为一个分享，以后我也会在这个专题里写一些有趣的工作小技巧，专治各种疑难杂症。开个玩笑，教程开始。

首先了解一下什么是VBA。Visual Basic for Applications（VBA）是Visual Basic的一种宏语言，是微软开发出来在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。简单的说，就是利用VBA，可以爆发出你office软件的洪荒之力。你想不到word也能帮你批量去完成一系列的任务是吧？

一、如何启动VBA

首先，启动你的word

word2013启动画面

启动完成后如果你和我一样是2013版的会是这样

word2013首页

嘿嘿，不小心看到了我的最近文档了是吧。最近在打算也做一套自己的编曲教程，如果有喜欢音乐的朋友可以关注。
好了，点击一下空白文档，进入熟悉的界面

熟悉的界面

这时候重点来了，按键盘的

ALT+F11

就可以进入VBA编程界面了

VBA编程界面

如果对于VBA编程感兴趣的话，我考虑要不要写一套VBA入门系列，但是在这里的话，我就直接提供了我的代码。各位无需知道具体的实现原理（其实原理也很简单），复制我的代码，点击插入-模块，粘贴即可。

插入模块 粘贴

其中有需要改动的参数如下

路径：

把引号“C:\Users\断梦霜丶跹尘\Desktop\新建文件夹”里面的内容替换成你存放word文档的路径（支持子目录）

子目录

密码

把 Const strPassword = "2009" 中引号2009改为这批word文档的密码。

输入密码

最后一步

在代码窗口的右上角选中

UnProtectAllDocFiles

选中

这时候可以按键盘上的F5运行直到提示完成即可。是不是很方便呢？

注意

如果程序出现了未知的问题，按ctrl+pause break强行停止运行即可。

代码如下

Option Explicit

Sub UnProtectAllDocFiles()
On Error Resume Next
Const strRootPath = "C:\Users\断梦霜丶跹尘\Desktop\新建文件夹"               ' 存放所有文件的目录，可以有子目录
Dim fso, oFolder
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strRootPath)
UnProtectDocFilesUnderFolder oFolder
MsgBox "成功"
End Sub
Sub UnProtectDocFilesUnderFolder(oFolder)
On Error Resume Next
Dim oSubFolder, oFile
Dim oDoc As Document
Const strPassword = "2009"     ' 这里输入word密码
For Each oSubFolder In oFolder.SubFolders
UnProtectDocFilesUnderFolder oSubFolder
For Each oFile In oSubFolder.Files
If InStr(oFile.Name, "doc") <> 0 Then
Set oDoc = Documents.Open(FileName:=oFile.Path, Visible:=False, PasswordDocument:=strPassword)
        With oDoc
            .ReadOnlyRecommended = False    '请勿省略
            .Password = ""
            .Close True   '关闭文档
        End With
    End If
Dim t
    t = DateAdd("s", 0.5, Now)
    Do Until Now > t
    DoEvents
    Loop
    Next
  Next
  
End Sub