问VBA删除打开Word文档的密码
EN

Stack Overflow用户

提问于 2021-08-11 20:19:25

回答 1查看 57关注 0票数 0

我教书，在考试期间，我为学生提供一些他们可以在文件夹中以数字方式使用的考试材料。他们不允许使用的教案也在同一文件夹中。我正在尝试编写VBA代码，以便在考试前锁定最多10个课程计划(word文档)，然后在考试后使用第二个sub来解锁相同的10个课程计划。我的课程计划文件夹和名称会定期更改，所以我在它们自己的"VSet“Sub中定义了它们。PWLock子模块使用选定的密码锁定所有文档。但是，PWUnlock不会删除"password to open“密码。我已经尝试了几种不同的方法来保存没有密码的文档，但都没有成功。无论我怎么尝试，一旦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:\FOLDER\FOLDER\FOLDER\TEST\"'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```

vba

ms-word

passwords

回答 1

Stack Overflow用户

发布于 2021-08-12 07:24:27

我不确定它背后的原因，但您需要在删除密码后将文件另存为其他名称，才能使其生效。

您的代码基本上是对每个文档重复相同的操作，因此建议将其放入sub中，这样更易于维护和阅读。为此，我将文档分别锁定和解锁为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

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/68748491

复制

相似问题

问VBA删除打开Word文档的密码
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VBA删除打开Word文档的密码EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问VBA删除打开Word文档的密码
EN