Desproteger hoja Excel

Xanito · el 11 de septiembre

Buen día Genios en Excel alguien tendrá algún código de vba para desproteger hoja de Excel, he buscado en el foro pero no des protege la hoja tampoco no se porque. Ya que uso el siguiente pero solo se queda pensando:

Excel VBA Brute Force Override v0.2a

Option Explicit
Option Private Module

Sub BruteForce_Override()
On Error GoTo ErrorHandler

Dim i As Byte, j As Byte, k As Byte
Dim l As Byte, m As Byte, n As Byte
Dim o As Byte, p As Byte, q As Byte
Dim r As Byte, s As Byte, t As Byte
Dim x As Integer, PassWd_Try As String

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 n = 65 To 66
For o = 65 To 66: For p = 65 To 66: For q = 65 To 66
For r = 65 To 66: For s = 65 To 66:
Application.StatusBar = x & "/194,560 Possible"
x = x + 94: For t = 1 To 126: DoEvents

PassWd_Try = Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(n) & Chr(o) & Chr(p) & _
Chr(q) & Chr(r) & Chr(s) & Chr(t + 31)

ActiveSheet.Unprotect Password:=PassWd_Try
If ActiveSheet.ProtectContents = False Then
MsgBox "Overide String Located:" & Chr(13) & _
PassWd_Try & Chr(13) & Chr(13) & _
"The Password has been overriden." & Chr(13) & _
"Do not save this file (with the same name)" & _
"or your breach may be detected.", _
vbExclamation, "Password Overridden"
Application.StatusBar = False
Exit Sub
End If

Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

Application.StatusBar = False
Exit Sub

ErrorHandler:
Select Case Err.Number
Case 1004 'Password Incorrect
Resume Next
Case Else
MsgBox Err.Source & Chr(13) & Err.Description, vbCritical, "Unknown Error #" & Err.Number
Application.StatusBar = False
On Error Goto 0
Exit Sub
End Select
End Sub

De antemano gracias por su ayuda.

Hoja- copia.xlsm

Antoni · el 12 de septiembre

Para contraseñas de 4 posiciones:

Ármate de paciencia, hay que probar con hasta cerca de 15.000.000 de posibilidades.

Sub Desproteger(): On Error GoTo NoPass
Dim L As String, Contraseña As String, Total As Long
L = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Debug.Print Time
For A = 1 To Len(L): For B = 1 To Len(L): For C = 1 To Len(L): For D = 1 To Len(L)
   '------------------------------------------------------
   Total = Total + 1
   Contraseña = Mid(L, A, 1) & _
                Mid(L, B, 1) & _
                Mid(L, C, 1) & _
                Mid(L, D, 1)
   ActiveSheet.Unprotect Password:=Contraseña
   If Contraseña <> "" Then
     Debug.Print Contraseña
     Debug.Print Time; Total
     Exit Sub
   End If
   '------------------------------------------------------
Next: Next: Next: Next
NoPass:
   Contraseña = ""
   Resume Next
End Sub

Xanito · el 12 de septiembre

Antoni es un gusto recivir tus respuestas, estoy probando el código que mandaste pero se queda pensando tambien☹️

Antoni · el 12 de septiembre

Hace 3 horas, Xanito dijo:

Antoni es un gusto recibir tus respuestas, estoy probando el código que mandaste pero se queda pensando tambien☹️

En mi PC, 21 segundos cada 1.000 intentos, o sea un montón de horas.

Xanito · el 12 de septiembre

Gracias por tu apoyo Antoni, si hay que tener paciencia para el desbloqueo.

Gerson Pineda · el 12 de septiembre

Hola

Te subo el archivo, ya sin la contraseña

Saludos a ambos!

[Content_Types].xlsx

Cristian 1985 · el 13 de septiembre

Gerson con su Supercomputadora ?????

Xanito · el 19 de septiembre

Que tal Gerson, disculpe que hasta ahora vi tu respuesta, esque ando de viaje. Pero me imagino que ahí dejaste el código, lo voy a ver mañana, gracias Gerson.

Gerson Pineda · el 19 de septiembre

Hace 2 horas, Xanito dijo:

Que tal Gerson, disculpe que hasta ahora vi tu respuesta, esque ando de viaje. Pero me imagino que ahí dejaste el código, lo voy a ver mañana, gracias Gerson.

No utilice ningún código y ningún programa de terceros, pero ahí lo tienes ya sin contraseña

Saludos