Question

对不起，我对解锁多个受保护的工作簿有一些疑问

由于我在一个文件夹中保护了大约200多个xlsm工作簿，因此可以说存储在“ C：\ temp”中

我还有另一个工作簿（称为password.xlsm）将那200个xlsm工作簿的密码存储在worksheet1中，我想按宏删除所有xlsm文件的所有密码。

例如

file  password
A     112233
B     225588
C     KKK999
..    ...

这是我的代码，我找到一些vba脚本供参考，但是我是菜鸟

Sub UnEncyptedFile()
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
Dim oWorkbook As Excel.Workbook
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim Pwcode As String

Dim filename As String
Dim LastRow As Long

Set objFSO = CreateObject("Scripting.FilesyStemObject")
Set objFolder = objFSO.GetFolder("C:\temp")

LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each objFile In objFolder.Files
    checkfilename = objFile.Name
    checkfilename = Left(checkfilename, Len(checkfilename) - 5)
       For i = 2 To LastRow
           If ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = checkfilename Then

           Pwcode = ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value    
           Set oWorkbook = oExcel.Workbooks.Open(objFolder & "\" & objFile.Name, Password:=Pwcode)
           oWorkbook.SaveAs Filename:=objFolder & "\" & objFile.Name, Password:=""
           oWorkbook.Close (True)

           End If
           Exit For
      Next i    
Next objFile
End Sub

如果我检查文件名等于我存储在“密码”中的文件名，则此工作簿在sheet1列A中然后我打开文件，将文件保存到其原始路径，然后删除密码：=“”

我成功打开了工作簿（A.xlsm），但是它没有自动分配密码，因此只打开了工作簿，但是我需要手动输入密码。...然后它停止循环

有人可以帮我解决问题吗？

Answer 1

尽管我改变了逻辑，您也可以尝试一下。我不是遍历文件夹，而是遍历存储在password.xlsm中的主excel（Column A）中的excel文件。

Sub Robot()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Loc As String: Loc = "C:\tempt\"
Dim pw As String, fn As String, cb As Workbook, i As Long

'Loc = Local Location
'pw = Password
'fn = File Name
'cb = Current Book

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        On Error Resume Next 'If book does not exist
            fn = Loc & ws.Range("A" & i)
            pw = ws.Range("B" & i)

            Set cb = Workbooks.Open(fn, Password:= pw)

            cb.SaveAs fn, Password:=""
            cb.Close False 'You just saved the book above, no need for TRUE
        On Error GoTo 0
    Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

解锁多个工作簿，每个工作簿都有自己的密码（VBA）

1 个答案: