解锁多个工作簿,每个工作簿都有自己的密码(VBA)

解锁多个工作簿,每个工作簿都有自己的密码(VBA),vba,excel,scripting,Vba,Excel,Scripting,抱歉,伙计们,我对解锁多个受保护的工作簿有一些疑问 因为我有大约200多本xlsm工作簿被保护在一个文件夹中,比如说存储在“C:\temp”中 我有另一个工作簿(称为password.xlsm)在工作表1中存储这200个xlsm工作簿的密码,我想通过宏删除所有xlsm文件的所有密码 比如 file password A 112233 B 225588 C KKK999 .. ... 这是我的代码,我找到了一些vba脚本供参考,但我是一个noob Sub UnEn

抱歉,伙计们,我对解锁多个受保护的工作簿有一些疑问

因为我有大约200多本xlsm工作簿被保护在一个文件夹中,比如说存储在“C:\temp”中

我有另一个工作簿(称为password.xlsm)在工作表1中存储这200个xlsm工作簿的密码,我想通过宏删除所有xlsm文件的所有密码

比如

file  password
A     112233
B     225588
C     KKK999
..    ...
这是我的代码,我找到了一些vba脚本供参考,但我是一个noob

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),但它没有自动分配密码,因此它只打开工作簿,但我需要手动输入密码。。。。然后它停止循环


有人能帮我找出问题出在哪里吗?

尽管我改变了逻辑,你还是可以试试这个。我不是在文件夹中循环,而是在主excel(
password.xlsm
)的
列A
中存储的excel文件中循环



你可以试试这个,尽管我改变了逻辑。我不是在文件夹中循环,而是在主excel(
password.xlsm
)的
列A
中存储的excel文件中循环



虽然我知道有另一种方法可以在不知道密码的情况下破解excel,但我不想使用它。虽然我知道有另一种方法可以在不知道密码的情况下破解excel,但我不想使用它。是否允许您打开字符串末尾带有
*
的wb?它无法解锁我的xlsm文件,但不存在任何错误。我认为你的观念比我的好。我想知道为什么没有错误,但仍然无法让worklet的我先试用,我存储在C:\temp中的所有文件都是xlsm(扩展名),例如:A.xlsm、B.xlsm、C.xlsm。。。。。。。我怎样才能加入你@urderboy,我是这个论坛的noob
Set cb=workbook.Open(fn,Password:=pw)
i thinkYES!!!密码:=pw,这是完美的工作,谢谢你们,我学到了很多!方法和逻辑很容易理解。但我还有一个问题,为什么我不需要在变量fn中添加“.xlsm”,xlsx和xlsm有什么不同吗?是否允许您打开一个在字符串末尾带有
*
的wb?它无法解锁我的xlsm文件,但不存在错误。我认为你的观念比我的好。我想知道为什么没有错误,但仍然无法让worklet的我先试用,我存储在C:\temp中的所有文件都是xlsm(扩展名),例如:A.xlsm、B.xlsm、C.xlsm。。。。。。。我怎样才能加入你@urderboy,我是这个论坛的noob
Set cb=workbook.Open(fn,Password:=pw)
i thinkYES!!!密码:=pw,这是完美的工作,谢谢你们,我学到了很多!方法和逻辑很容易理解。但是我还有一个问题,为什么我不需要在变量fn中加“.xlsm”,xlsx和xlsm有什么不同吗?
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