使用 VBA 从 Excel 个文件的目录中删除已知密码

Question

我找到了这个 VBA 代码，它可以很好地删除一个 Excel 工作簿上的已知密码。

Sub testPasswordRemoval()

Dim wb As Workbook

Set wb = Workbooks.Open(Filename:="C:\Temp\Book2.xlsm", Password:="pw")
wb.Password = ""
wb.SaveAs "C:\Temp\NewBook.xlsm"

End Sub

但是，我已经尝试了各种教程和视频（很多人都提供了这个）但是 none 他们努力循环遍历 .xlsx 文件的文件夹（都具有相同的已知密码）并删除相同的密码。

我不是 VBA 人，但在过去三天里花了大约 16 个小时试图破解这个代码。我发现了几个循环访问目录中文件的示例，但是 none 使我能够将上述代码放入其中并循环并删除密码。

Answer 1

试试这段代码，阅读评论，然后根据您的需要进行调整

代码：

Public Sub RemovePassLoopThroughFiles()
    
    Dim targetWorkbook As Workbook
    
    Dim filePath As String
    Dim folderPath As String
    Dim folderWildcard As String
    Dim currentFileName As String
    Dim currentFileExtension As String
    Dim newFileName As String
    Dim newfileNameSuffix As String
    Dim currentPassword As String
    Dim newPassword As String
    
    ' Adjust next lines to fit your needs
    
    folderPath = "C:\Temp\" ' With slash at the end
    folderWildcard = "*.xls*" ' You can change the suffix to open specific files
    
    newfileNameSuffix = "_NoPassword"
    
    currentPassword = "pw"
    newPassword = ""
    
    ' Get the file path concat folder and wildcards
    filePath = Dir(folderPath & folderWildcard)
      
    
    Do While Len(filePath) > 0
        ' Open the workbook and set reference
        Set targetWorkbook = Workbooks.Open(Filename:=filePath, Password:=currentPassword)
        
        ' Get current file extension
        currentFileExtension = Right(filePath, Len(filePath) - InStrRev(filePath, "."))
        
        ' Get filename no extension
        currentFileName = Left(filePath, InStrRev(filePath, ".") - 1)
        
        ' Build new fileName
        newFileName = currentFileName & newfileNameSuffix & "." & currentFileExtension
        
        ' Set new password
        targetWorkbook.Password = newPassword
        
        ' Save new file
        targetWorkbook.SaveAs folderPath & newFileName

        'Debug.Print filePath
        
        filePath = Dir

        targetWorkbook.Close True
        
        Set targetWorkbook = Nothing
        
    Loop
    
End Sub

如果有效请告诉我。

使用 VBA 从 Excel 个文件的目录中删除已知密码

Remove known password from directory of Excel files with VBA

passwords

excel

vba

loops