Saltar al contenido

VBA: compruebe si un libro de trabajo está protegido antes de abrirlo

Solución:

Pensé un poco más en esto y se me ocurrió lo siguiente, aunque necesitará muchas más pruebas y probablemente un poco de modificación. No me gusta que el resultado predeterminado sea que está protegido, pero en mi prueba rápida solo pude obtener un archivo no protegido para enumerar sus elementos.

Esto funciona convirtiendo el archivo en un archivo zip, intentando navegar por su contenido y luego convirtiéndolo de nuevo al tipo original. Solo lo he probado con xlsx archivos, pero el principio debe ser el mismo para xlsm así como. Una vez convertido, uso un shell para explorar el contenido del zip. Un archivo desprotegido devolverá una lista de su contenido, mientras que uno protegido no lo hará.

Public Function IsWorkbookProtected(WorkbookPath As String) As Boolean
    Dim fileExtension As String
    Dim tmpPath As Variant
    Dim sh As Object
    Dim n

    fileExtension = Right(WorkbookPath, Len(WorkbookPath) - InStrRev(WorkbookPath, "."))
    tmpPath = Left(WorkbookPath, InStrRev(WorkbookPath, ".")) & "zip"

    Name WorkbookPath As tmpPath

    Set sh = CreateObject("shell.application")
    Set n = sh.Namespace(tmpPath)

    IsWorkbookProtected = Not n.Items.Count > 0

    Name tmpPath As WorkbookPath

End Function

Llamado usando

Sub test()
    Dim FolderPath As String
    Dim fPath1 As String, fPath2 As String

    FolderPath = "ParentFolder"

    ' protected
    fPath1 = FolderPath & "testProtection.xlsx"
    ' unprotected
    fPath2 = FolderPath & "testProtection - Copy.xlsx"

    Debug.Print fPath1, IsWorkbookProtected(fPath1)
    Debug.Print fPath2, IsWorkbookProtected(fPath2)
End Sub

Salida a ventana inmediata:

ParentFoldertestProtection.xlsx     True
ParentFoldertestProtection - Copy.xlsx   False

Esta fue una breve prueba para explorar el problema y afirmaré que lo más probable es que esta no sea una respuesta concluyente ni infalible. Idealmente, querría recorrer el contenido de la carpeta zip y probar el ‘Paquete cifrado’ pero NameSpace no devolvía ningún artículo. Puede que haya otra forma de hacerlo, pero no he investigado más.

Contenido del archivo zip protegido de Excel:
ingrese la descripción de la imagen aquí

Contenido zip del archivo de Excel no protegido:
ingrese la descripción de la imagen aquí

Actualización con pruebas de temporizador

Usando un código de temporizador de TheSpreadSheetGuru

Sub CalculateRunTime_Seconds()
    'PURPOSE: Determine how many seconds it took for code to completely run
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    'Remember time when macro starts
      StartTime = Timer

'    Debug.Print "IsWorkbookProtected"
    Debug.Print "testOpen"

    '*****************************
    'Insert Your Code Here...
    '*****************************
'    Call testZip
    Call testOpen

    'Determine how many seconds code took to run
      SecondsElapsed = Round(Timer - StartTime, 2)

    'Notify user in seconds
      Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds"

End Sub

y usando el siguiente código para probar abriendo los archivos, probando la protección y cerrando

Sub testOpen()
    Dim wb As Workbook
    Dim FolderPath As String
    Dim fPath1 As String, fPath2 As String
    Dim j As Long

    FolderPath = "FolderPath"

    Application.ScreenUpdating = False
    ' protected
    fPath1 = FolderPath & "testProtection.xlsx"
    ' unprotected
    fPath2 = FolderPath & "testProtection - Copy.xlsx"
    For j = 1 To 2

        On Error Resume Next
        Set wb = Workbooks.Open(Choose(j, fPath1, fPath2), , , , "")

        Debug.Print Choose(j, fPath1, fPath2), wb Is Nothing

        wb.Close
        On Error GoTo 0
    Next j

    Application.ScreenUpdating = True

End Sub

Tengo los siguientes tiempos:

ingrese la descripción de la imagen aquí

Ejecute esto varias veces y obtenga resultados similares

Esto no está respaldado por ninguna documentación, pero creo que encontré algo interesante. Tengo curiosidad por conocer otras opiniones sobre esto.


Hipótesis

Entonces, cada vez que revisé todas las propiedades de mi archivo, había una propiedad que aparentemente cambiaba cuando un archivo estaba protegido con contraseña, esta era la propiedad 42 (siendo la “Nombre del programa”), parte de las propiedades extendidas del archivo. Vea la captura de pantalla a continuación (por @Tom), donde la izquierda es un archivo desprotegido y la derecha está protegida.

ingrese la descripción de la imagen aquí

Cada vez que desprotegía un libro, aparecía un valor, por ejemplo, “Microsoft Excel” o incluso a veces “Microsoft Excel Online”. Sin embargo, en todos los casos protegí el libro de trabajo, el valor estaba vacío. Por lo tanto, eso me dejó pensando que mirar esta propiedad específica nos dice de alguna manera que el archivo está protegido cuando la propiedad está vacía. ¿Podría esto porque la propiedad no se puede leer debido a la protección?

Con la ayuda de @Tom, descubrimos que el índice de esta propiedad puede diferir. Mientras que en mi sistema esta propiedad tiene el índice 42, parecía que en el sistema de Tom se ubicaría por debajo de 8. Por lo tanto, implementó amablemente un bucle inteligente para devolver el índice correcto antes de ejecutar el bucle de los archivos. Notable: ¡El nombre de la propiedad depende del idioma! Para holandés, buscaría “Programmanaam”, por ejemplo.


Código

Usando el siguiente código podemos ir a través de una carpeta específica y recorrer archivos para devolver el valor de esta propiedad específica:

Sub MySub()

Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir:   Set oDir = oShell.Namespace("C:Users...")
Dim i as long, x as long

For i = 0 To 288
    If oDir.GetDetailsOf(oDir.Items, i) = "Program name" Then
        x = i
        Exit For
    End If
Next i

For Each sFile In oDir.Items
    If oDir.GetDetailsOf(sFile, x) = "" Then
        Debug.Print sFile.Name & " is protected"
    Else
        Debug.Print sFile.Name & " is unprotected and can be openened"
    End If
Next

End Sub

Para adaptar eso un poco más, repita un rango y verifique un montón de nombres de libros de trabajo que podrían verse como:

ingrese la descripción de la imagen aquí

El código de trabajo se ve así:

Sub MySub()

Dim MainPath As String: MainPath = "C:Users..."
Dim i As Long, x As Long
Dim oDir As Object: Set oDir = CreateObject("Shell.Application").Namespace(CStr(MainPath))

'Get the right index for property "Program Name"
For i = 0 To 288
    If oDir.GetDetailsOf(oDir.Items, i) = "Program Name" Then
        x = i
        Exit For
    End If
Next i

'Loop the range of workbooks and check whether or not they are protected
With ThisWorkbook.Sheets("Sheet1") 'Change accordingly
    For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If oDir.GetDetailsOf(oDir.Items.Item(CStr(.Cells(i, 1))), x) = "" Then
            Debug.Print .Cells(i, 1) & " is protected"
        Else
            Debug.Print .Cells(i, 1) & " is unprotected and can be openened"
            'Open your workbook here?
        End If
    Next i
End With

End Sub

Nota: Tenga en cuenta el uso de Cstr() tanto en MainPath como en el valor de la celda. Hasta donde yo sé, no está muy claro por qué, pero sin él, el código devolverá un ‘Error 445: El objeto no admite esta acción’ Actualizar: Consulte esta pregunta para obtener más información sobre este tema específico.


Ejemplo

Por ejemplo, tengo los siguientes libros de trabajo, con Map2 y Map5 protegidos:

ingrese la descripción de la imagen aquí

Ventana inmediata después de ejecutar la primera macro:

ingrese la descripción de la imagen aquí

A continuación, solo protegí map1 y map3 con el siguiente resultado:

ingrese la descripción de la imagen aquí


Conclusión

¿Hipótesis probada? No lo sé, pero por mi parte no ha habido una sola vez que se haya demostrado que la hipótesis es incorrecta. Nuevamente, no hay documentación sobre esto. Pero esta podría ser su forma de saber muy rápidamente si un libro de trabajo está protegido o no.

Por cierto, tomé prestado un formulario de código aquí

¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)



Utiliza Nuestro Buscador

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *