Views

Histats

Vitrine

VBA Excel - Desbloqueando as worksheets com VBA (How to hack a lost worksheet password with VBA to unprotect the worksheet)




Por estarmos envolvidos em tantos projetos simultaneamente, não raro acontece de esquecermos as senhas de proteção das worksheets. Neste momento saimos correndo atrás de programas que possam desbloquear nossas planilhas. Abaixo está um bem estruturado código capaz de retirar a proteção das nossas woksheets. É uma implementação válida e digna de ficar sempre à mão. Agora poderá a qualquer momento copiá-la daqui e implementá-la em sua planilha para o pronto desbloqueio. Use a chamada para evocar a solução:

Call AllPasswordsRemover(ActiveWorkbook)

Public Sub AllPasswordsRemover(wb As Workbook)
 Dim w1 As Worksheet Dim w2 As Worksheet
 Dim i As Integer Dim j As Integer Dim k As Integer
 Dim l As Integer Dim m As Integer Dim n As Integer
 Dim i1 As Integer Dim i2 As Integer Dim i3 As Integer
 Dim i4 As Integer Dim i5 As Integer Dim i6 As Integer
 Dim PWord1 As String Dim ShTag As Boolean
 Dim WinTag As Boolean ' Início da tentativa de desproteger o wb (workBook), Application.ScreenUpdating = False ' Verifica se está protegido With wb Let WinTag = .ProtectStructure Or .ProtectWindows End With Let ShTag = False ' Estão realmente protegidos? For Each w1 In Worksheets Let ShTag = ShTag Or w1.ProtectContents Next w1 ' Caso não haja proteção, o processo é encerrado! If Not ShTag And Not WinTag Then GoTo exx End If ' Dependendo da senha e de quantas planilhas estiverem protegidas com diferentes senhas, ' o processo talvez leve um tempo considerável. Estimo entre 3-6 minutos por senha. If Not WinTag Then ' Workbook não está protegido... vai checar as planilhas... Else ' Workbook está protegido, desprontegendo-o On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With wb .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then Let PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ' Achamos o password para este workbook. MsgBox "A Worksheet '" & w1.Name & "' foi desprotegida usando o seguinte hash " & _ "Hashed Password:" & Chr(13) & PWord1 & Chr(13) & "Tente desproteger outras " & _ "planilhas com este mesmo password..." Exit Do End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then ' Worksheets Não estão protegidas. GoTo exx End If ' Caso as worksheets estiverem protegidas... On Error Resume Next For Each w1 In Worksheets w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False ' Checa se a tentativa foi bem sucedida. For Each w1 In Worksheets ' Checa para todas as ShTag engatilhadas para 1, se não. Let ShTag = ShTag Or w1.ProtectContents Next w1 ' Caso haja worksheet protegida, desprotege-a. If ShTag Then For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ' Achamos 1! MsgBox "A Worksheet '" & w1.Name & "' foi desprotegida usando o seguinte hash " & _ "Hashed Password:" & Chr(13) & PWord1 & Chr(13) & "Tente desproteger outras " & _ "planilhas com este mesmo password..." For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 Else Debug.Print ("Estas worksheets '" & w1.Name & "' não estavam protegidas.") End If End With Next w1 End If GoTo exx exx: Application.ScreenUpdating = True
End Sub

 Para os que desejarem aprofundar-se na lógica do como foi possível chegar a este resultado poderão fazê-lo Aqui.

✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias