6
votes

VBA - Vérifiez si un classeur est protégé avant de l'ouvrir

Existe-t-il un moyen de vérifier si un classeur est protégé avant d' essayer de l'ouvrir.

Voici mon code mais je n'ai aucune idée du chemin (si c'est possible)

Sub MySub()
Dim Wb As Workbook
For i = 14 To Cells(Rows.Count, 1).End(xlUp).Row
'I Would like to check if the workbook is Protected here

Set Wb = GetObject(Cells(i, 4).Value)



Wb.Open

End Sub

Remarque: Dans ce code Cells(i,4).Value will be equal to the workbooks path.


4 commentaires

Pas pour autant que je sache. Vous pouvez essayer de l'ouvrir sans le mot de passe et détecter l'erreur comme indication


@Tom Merci pour votre commentaire, je vais essayer de cette façon ... Mais j'espère que quelqu'un connaît une réponse à mon problème cela aiderait pour la prochaine ..


d'accord - serait intéressant de voir s'il existe un moyen. Je pourrais imaginer que cela soit possible si le statut protégé était exposé comme l'une des propriétés du fichier mais ne pense pas que ce soit


@Tom Je n'ai rien trouvé sur le web, Voyons ce que les autres en pensent: D, peut-être que les votes positifs peuvent attirer un expert en VBA Quoi qu'il en soit merci pour votre suggestion que je vais essayer de trouver par moi-même


4 Réponses :


-1
votes

Peut-être que cela ne vous satisfera pas pleinement, mais peut-être vous aider un peu.

Sub checkif()

On Error GoTo ErrHand

    Dim obj As Object
    Dim strFileName

    strFileName = "filepath"

    Set obj = Workbooks.Open(strFileName, , , , "")

    Exit Sub
ErrHand:

    If Err() = 1004 Then
        MsgBox "Protected"
    End If

End Sub


3 commentaires

Cela ouvrira le classeur. Question à poser avant l'ouverture


Mais s'il est protégé, il vous le dira. Comme je l'ai dit, je voulais juste un peu d'aide, j'ai pensé que c'était un endroit pour recueillir des idées, merci.


@Teamothy Merci pour cette réponse mais le fait est que j'ai beaucoup de fichiers à ouvrir et que cette voie est longue, c'est pourquoi je voulais savoir s'il y avait une possibilité de vérifier le fichier avant de l'ouvrir.



10
votes

J'ai réfléchi un peu plus à cela et j'ai trouvé ce qui suit - bien qu'il faudra beaucoup plus de tests et probablement un peu de modification. Je n'aime pas le fait que le résultat par défaut est qu'il est protégé, mais dans mon test rapide, je n'ai pu obtenir qu'un fichier non protégé pour répertorier ses éléments.

Cela fonctionne en convertissant le fichier en fichier zip, en essayant de naviguer dans son contenu, puis en le reconvertissant au type d'origine. Je ne l'ai testé qu'avec des fichiers xlsx mais le principe devrait être le même pour xlsm également. Une fois converti, j'utilise un shell pour explorer le contenu du zip. Un fichier non protégé renverra une liste de son contenu, contrairement à un fichier protégé.

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

Appelé en utilisant

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

Sortie vers la fenêtre immédiate:

ParentFolder\testProtection.xlsx     True
ParentFolder\testProtection - Copy.xlsx   False

Il s'agissait d'un bref test pour explorer la question et je dirai que ce n'est probablement pas une réponse concluante ni infaillible. Idéalement, je voudrais parcourir le contenu du dossier zip et tester le 'EncryptedPackage' mais NameSpace ne retournait aucun élément. Il y a peut-être une autre façon de le faire, mais je n'ai pas enquêté davantage.

Contenu du fichier zip protégé Excel: entrez la description de l'image ici

Contenu du fichier zip Excel non protégé: entrez la description de l'image ici

Mise à jour avec des tests de minuterie

Utilisation d'un code de minuterie de TheSpreadSheetGuru

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

et en utilisant le code suivant pour tester en ouvrant les fichiers, en testant la protection et en fermant

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

J'ai eu les temps suivants:

entrez la description de l'image ici

Exécutez ceci plusieurs fois et obtenez des résultats similaires


6 commentaires

Je vous donnerai des commentaires dès que possible, merci pour votre temps et votre considération


Je ne comprends pas, mais un test rapide montre que cela fonctionne. Très intelligent.


@SJR Je travaille sur le principe qu'un fichier Excel est essentiellement un dossier de contenu en le convertissant en un dossier zip, je peux parcourir le package. Elle doit vraiment être testée et étoffée avant d'être acceptée comme méthode concluante, mais c'est un début facultatif possible. Merci pour le compliment :)


Bonne réflexion, est-ce que ce serait plus rapide que la vérification à l'ouverture du classeur? Avez-vous effectué des tests de vitesse?


@Tom Merci pour votre temps et ce travail, je parie que cela peut aider beaucoup d'utilisateurs;)


Nice Tom, j'ai moi-même joué avec ExecuteExcel4Macro pour renvoyer n'importe quelle valeur de cellule à partir d'un classeur protégé, mais j'ai constamment reçu l'invite modale pour un mot de passe. Si seulement il y avait un moyen de renvoyer simplement une erreur au lieu de l'invite. Quoi qu'il en soit, votre solution est une trouvaille très cool :)



5
votes

Ceci n'est complètement pris en charge par aucune documentation, mais je pense que j'ai trouvé quelque chose d'intéressant. Je suis curieux d'avoir d'autres opinions à ce sujet.


Hypothèse

Ainsi, chaque fois que je parcourais toutes les propriétés de mon fichier, il y avait une propriété qui apparemment changeait quand un fichier était protégé par mot de passe, c'était la propriété 42 (étant le «nom du programme» ), qui faisait partie des propriétés étendues du fichier. Voir la capture d'écran ci-dessous (par @Tom), où la gauche est un fichier non protégé et la droite est protégée.

entrez la description de l'image ici

Chaque fois que je déprotégeais un classeur, une valeur apparaissait, par exemple "Microsoft Excel" ou même parfois "Microsoft Excel Online". Cependant, dans tous les cas où j'ai protégé le classeur, la valeur était vide. Par conséquent, cela m'a laissé penser que regarder cette propriété spécifique nous indique d'une certaine manière que le fichier est protégé lorsque la propriété est vide. Cela pourrait-il parce que la propriété ne peut pas être lue à cause de la protection?

Avec l'aide de @Tom, nous avons constaté que l'index de cette propriété peut différer. Alors que sur mon système cette propriété a l'index 42, il est apparu que sur le système de Tom, elle se situerait sous 8. Il a donc gentiment implémenté une boucle intelligente pour renvoyer le bon index avant de boucler les fichiers. À noter: le nom de la propriété dépend de la langue! Pour le néerlandais, je chercherais par exemple "Programmanaam".


Code

En utilisant le code suivant, nous pouvons parcourir un dossier spécifique et des fichiers en boucle pour renvoyer la valeur de cette propriété spécifique:

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

Pour adapter un peu plus cela pour boucler une plage et vérifier un tas de noms de classeurs qui pourraient ressembler à:

entrez la description de l'image ici

Le code de travail ressemble à:

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

Remarque: veuillez noter l'utilisation de Cstr() à la fois sur MainPath et sur la valeur de la cellule. Pour autant que je sache, la raison n'est pas très claire, mais sans elle, le code renverra une `` Erreur 445: l'objet ne prend pas en charge cette action '' Mise à jour: Consultezcette question pour plus d'informations sur ce problème spécifique.


Exemple

Par exemple, j'ai les classeurs suivants, avec Map2 et Map5 protégés:

entrez la description de l'image ici

Fenêtre immédiate après l'exécution de la première macro:

entrez la description de l'image ici

Ensuite, je n'ai protégé que map1 et map3 avec le résultat suivant:

entrez la description de l'image ici


Conclusion

Hypothèse prouvée? Je ne sais pas, mais de mon côté, il n'y a pas eu une seule fois où l'hypothèse s'est avérée fausse. Encore une fois, il n'y a pas de documentation à ce sujet. Mais cela pourrait être votre moyen de savoir très rapidement si un classeur est protégé ou non.

Btw, j'ai emprunté une forme de code ici


0 commentaires

0
votes

Ce que je voudrais proposer, c'est d'utiliser la signature de fichier, la chaîne magique d'octets qui - en plus de l'extension de fichier - aide les systèmes d'exploitation et les programmes à déterminer à quoi ils ont affaire. Selon la base de données de confiance TrID, la chaîne magique définissant un fichier Excel crypté (alias `` fichier composé OLE2 / multiflux crypté '') se compose des huit octets suivants: D0 CF 11 E0 A1 B1 1A E1 .

Sachant cela, nous pouvons vérifier leur existence comme suit:

Public Function IsPasswordProtected(strFilePath As String) As Boolean
    ' Open file for byte reading, check length
    Dim fileInt As Integer: fileInt = FreeFile
    Open strFilePath For Binary Access Read As #fileInt
    If LOF(fileInt) < 8 Then
        Exit Function
    End If
    
    ' Fetch the first bytes
    Dim arrFile(0 To 7) As Byte
    Get #fileInt, , arrFile
    Close #fileInt
    
    ' Compare with Encrypted OLE2 / Multistream Compound File magic
    ' D0 CF 11 E0 A1 B1 1A E1
    Dim arrSignature(0 To 7) As Byte, i As Integer
    For i = LBound(arrSignature) To UBound(arrSignature)
        arrSignature(i) = Choose(i + 1, &HD0, &HCF, &H11, &HE0, &HA1, &HB1, &H1A, &HE1)
    Next
    If StrConv(arrFile, vbUnicode) = StrConv(arrSignature, vbUnicode) Then
        IsPasswordProtected = True
    End If
End Function

Veuillez noter que ce qui précède ne contient pas de traitement approprié des erreurs. Gardez également à l'esprit que la signature est également partagée avec des fichiers XLS non protégés et ne conduira donc à des conclusions correctes que pour les fichiers XLSX.


0 commentaires