VBA删除打开Word文档的密码

Question

我是老师，在考试期间，我给学生提供一些他们可以在考试中使用的数字材料。他们不允许使用的教案也在同一个文件夹里。我正试图编写VBA代码来锁定考试前的10个课程计划(word文档)，然后第二个sub来解锁考试后相同的10个课程计划。我的教案文件夹和名称会定期更换，所以我把它们定义在自己的"vset"中。子。PWLock子用所选密码锁定所有文档。但是，PWUnlock不会删除该"密码"以打开"密码"。密码。我尝试了几种不同的方法来保存没有密码的文件，但都没有成功。无论我怎么尝试，一旦密码被PWLock设置，我就不能用我的VBA删除它，但如果我打开文档，然后手动保存文档时删除密码，就可以删除它。提前感谢您的时间和考虑。这是我的代码-

Dim ComPath, LP1Path, LP2Path, LP3Path, LP4Path, LP5Path, LP6Path, LP7Path, LP8Path, LP9Path, LP10Path As String
Dim LP1Folder, LP2Folder, LP3Folder, LP4Folder, LP5Folder, LP6Folder, LP7Folder, LP8Folder, LP9Folder, LP10Folder As String
Dim LP1, LP2, LP3, LP4, LP5, LP6, LP7, LP8, LP9, LP10 As String
Public Const strPassword As String = "password"
Public Const noPassword As String = ""

Sub VSet() 'Used as a single place to set the variables for use in the PWLock and PWUnlock Subs so they can be easily changed for each teaching cycle

ComPath = "K:FOLDERFOLDERFOLDERTEST"'Change this path as needed to main folder for cycle
'Folders are the individual folders for each class - change as needed - comment out unneeded folders
LP1Folder = "Class 1"
LP2Folder = "Class 2"
LP3Folder = "Class 3"
LP4Folder = "Class 4"
LP5Folder = "Class 5"
LP6Folder = "Class 6"
LP7Folder = "Class 7"
LP8Folder = "Class 8"
LP9Folder = "Class 9"
LP10Folder = "Class 10"
'Lesson plan file names with extenstions - change as needed - comment out unneeded file names
LP1 = "Class 1 LP.docx"
LP2 = "Class 2 LP.docx"
LP3 = "Class 3 LP.docx"
LP4 = "Class 4 LP.docx."
LP5 = "Class 5 LP.docx."
LP6 = "Class 6 LP.docx"
LP7 = "Class 7 LP.docx"
LP8 = "Class 8 LP.docx"
LP9 = "Class 9 LP.docx"
LP10 = "Class 10 LP.docx"
'Paths to open and save documents - should not need to be changed - comment out unneeded paths
LP1Path = ComPath & LP1Folder & LP1
LP2Path = ComPath & LP2Folder & LP2
LP3Path = ComPath & LP3Folder & LP3
LP4Path = ComPath & LP4Folder & LP4
LP5Path = ComPath & LP5Folder & LP5
LP6Path = ComPath & LP6Folder & LP6
LP7Path = ComPath & LP7Folder & LP7
LP8Path = ComPath & LP8Folder & LP8
LP9Path = ComPath & LP9Folder & LP9
LP10Path = ComPath & LP10Folder & LP10
End Sub

Sub PWLock()

VSet
'LP1 - lesson plan
Documents.Open FileName:=LP1Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP1Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP2 - lesson plan
Documents.Open FileName:=LP2Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP2Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP3 - lesson plan
Documents.Open FileName:=LP3Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP3Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP4 - lesson plan
Documents.Open FileName:=LP4Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP4Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP5 lesson plan
Documents.Open FileName:=LP5Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP5Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP6 - lesson plan
Documents.Open FileName:=LP6Path
With ActiveDocument
.Password = strPassword
.SaveAs FileName:=LP6Path, Password:=strPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP7 - lesson plan
'    Documents.Open FileName:=LP7Path
'    With ActiveDocument
'        .Password = strPassword
'        .SaveAs FileName:=LP7Path, Password:=strPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'LP8 - lesson plan
'    Documents.Open FileName:=LP8Path
'    With ActiveDocument
'        .Password = strPassword
'        .SaveAs FileName:=LP8Path, Password:=strPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'LP9 - lesson plan
'    Documents.Open FileName:=LP9Path
'    With ActiveDocument
'        .Password = strPassword
'        .SaveAs FileName:=LP9Path, Password:=strPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'LP10 - lesson plan
'    Documents.Open FileName:=LP10Path
'    With ActiveDocument
'        .Password = strPassword
'        .SaveAs FileName:=LP10Path, Password:=strPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
CloseAll
End Sub
Sub PWUnlock()
VSet
'LP1 - lesson plan
Documents.Open FileName:=LP1Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP1Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP2 - lesson plan
Documents.Open FileName:=LP2Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP2Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP3 - lesson plan
Documents.Open FileName:=LP3Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP3Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP4 - lesson plan
Documents.Open FileName:=LP4Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP4Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP5 - lesson plan
Documents.Open FileName:=LP5Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP5Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'LP6 - lesson plan
Documents.Open FileName:=LP6Path, PasswordDocument:=strPassword
With ActiveDocument
.Password = noPassword
.SaveAs FileName:=LP6Path, Password:=noPassword
ActiveDocument.Close SaveChanges:=wdSaveChanges
End With
'    'LP7 - lesson plan
'    Documents.Open FileName:=LP7Path, PasswordDocument:=strPassword
'    With ActiveDocument
'        .Password = noPassword
'        .SaveAs FileName:=LP7Path, Password:=noPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'    'LP8 - lesson plan
'    Documents.Open FileName:=LP8Path, PasswordDocument:=strPassword
'    With ActiveDocument
'        .Password = noPassword
'        .SaveAs FileName:=LP8Path, Password:=noPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'    'LP9 - lesson plan
'    Documents.Open FileName:=LP9Path, PasswordDocument:=strPassword
'    With ActiveDocument
'        .Password = noPassword
'        .SaveAs FileName:=LP9Path, Password:=noPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
'    'LP10 - lesson plan
'    Documents.Open FileName:=LP10Path, PasswordDocument:=strPassword
'    With ActiveDocument
'        .Password = noPassword
'        .SaveAs FileName:=LP10Path, Password:=noPassword
'        ActiveDocument.Close SaveChanges:=wdSaveChanges
'    End With
End Sub
Sub CloseAll()
'Close all open files and shutdown Word

With Application
.ScreenUpdating = False

'Loop Through open documents
Do Until .Documents.Count = 0
'Close saving changes
.Documents(1).Close SaveChanges:=wdSaveChanges
Loop

'Quit Word no save
.Quit SaveChanges:=wdSaveChanges
End With
End Sub```

Answer 1

我不知道这背后的原因是什么，但你需要在删除密码后将文件保存为另一个名称才能生效。

你的代码基本上对每个文档重复相同的操作，所以建议把它变成一个子，这样更容易维护和阅读。为此，我将文档的锁定和解锁分别设置为Sub,LockDocument和UnlockDocument。

由于您还手动提供文件名，这可能会导致您出现错别字并且文件实际上不存在的情况，因此我还在锁定/解锁之前添加了检查，以查看文件是否存在，然后再继续。

正如您所看到的，现在您的PWLock和PWUnlock子程序已经有效地简化为仅使用文件路径调用子程序。

Sub PWLock()
VSet

LockDocument LP1Path
LockDocument LP2Path
LockDocument LP3Path
End Sub
Sub PWUnlock()
VSet

UnlockDocument LP1Path
UnlockDocument LP2Path
UnlockDocument LP3Path
End Sub
Sub LockDocument(argPath As String)
'Lock the document with the given path name

If Dir(argPath) <> vbNullString Then    'Check if the file exist before proceeding to lock
Dim lockDoc As Document
Set lockDoc = Application.Documents.Open(FileName:=argPath, Visible:=False)

With lockDoc
.Password = strPassword
.SaveAs FileName:=argPath, Password:=strPassword
.Close SaveChanges:=wdSaveChanges
End With

Set lockDoc = Nothing
Else
'Error - File not found
MsgBox "Error - File not exist: " & vbNewLine & _
argPath
End If
End Sub

Sub UnlockDocument(argPath As String)
'Unlock the document with the given path name

If Dir(argPath) <> vbNullString Then    'Check if the file exist first before proceeding to unlock

'Rename the file to a temp name
Dim tempPath As String
tempPath = Replace(argPath, ".docx", " (Temp).docx")
Name argPath As tempPath

Dim unlockDoc As Document
Set unlockDoc = Application.Documents.Open(FileName:=tempPath, PasswordDocument:=strPassword, Visible:=False)
With unlockDoc
.Password = noPassword
.SaveAs FileName:=argPath, Password:=noPassword 'Save back to the original file name
.Close SaveChanges:=wdSaveChanges
End With

Kill tempPath   'Delete the temp file
Set unlockDoc = Nothing
Else
'Error - File not found
MsgBox "Error - File not exist: " & vbNewLine & _
argPath
End If
End Sub