批量取消word密码.vb

Option Explicit

Sub UnProtectAllDocFiles()

On Error Resume Next

Const strRootPath = "F:\doc" ' 存放文档的目录
Const strPassword = "0216" ' 密码

Dim oDoc As Document
Dim fso, oFolder, oFile

Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strRootPath)
For Each oFile In oFolder.Files
Set oDoc = Documents.Open(FileName:=oFile.Path, PasswordDocument:=strPassword)
oDoc.Saved = False
oDoc.SaveAs FileName:=oFile.Path, Password:="", WritePassword:=""
oDoc.Close
Next

MsgBox "完成！"

End Sub