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 Réponses :
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
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.
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:
Contenu du fichier zip Excel non protégé:
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:
Exécutez ceci plusieurs fois et obtenez des résultats similaires
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 :)
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.
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 à:
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:
Fenêtre immédiate après l'exécution de la première macro:
Ensuite, je n'ai protégé que map1 et map3 avec le résultat suivant:
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
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.
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