Error 70

Question

Bonjour à toutes et tous,
je développe à mon rythme et à titre personnel.
Dans les 2 procédures ci-jointes il me reste un gros soucis que je n'arrive pas à résoudre.
Le but de ces procédures est : - lire mes drives (C:, D:, F: et G:) ; - récupérer le nom des dossiers de chacun des drives en excluant les attributs 2, 4, et 2048 ; les coordonnées des dossiers sont enregistrées dans la table t_DOSSIERS.
Le souci : je reste bloqué sur l'attribut "Permission refusée" qui génère l'erreur 70.
Ma demande : comment éviter cette erreur n° 70, la gestion d'erreur ou un Resume next ne fonctionne pas sur ce type d'attribut.
Avec mes humbles remerciements de la part d'un retraité de 80 ans dans quelques semaines
'**************************************
' ******************************************************************************************
' *** Parcourir les disques spécifiés
' *** Lire les données de chaques dossiers/sous-dossiers
' *** afficher le résultat dans la table t_DOSSIERS
' ******************************************************************************************

Sub ParcourirDisquesEtDossiers()
Dim db As DAO.Database
Dim rsDisk As DAO.Recordset
Dim rsDos As DAO.Recordset
Dim fso As Object
Dim dossier As Object
Dim disk As Object

Set db = CurrentDb  
Set rsDisk = db.OpenRecordset("t\_DISQUES", dbOpenSnapshot)  
Set rsDos = db.OpenRecordset("t\_DOSSIERS", dbOpenDynaset)  
Set fso = CreateObject("Scripting.FileSystemObject")  
  
On Error GoTo GestionErreur  
  
Do While Not rsDisk.EOF  
    ' \*\*\* Parcourir les disques  
    If fso.DriveExists(rsDisk!LettreDisque) Then  
        Set dossier = fso.GetFolder(rsDisk!LettreDisque)  
          
        ' \*\*\* Lire les attributs du dossier  
        If (dossier.Attributes And (1 Or 2 Or 4 Or 2048)) = 0 Then  
            ' \*\*\* Exclure les dossiers de taille 0  
            If dossier.Size > 0 Then  

                ' \*\*\* Parcourir les dossiers et sous-dossiers du disque en cours  
                Call ParcourirDossiers(disk, dossier, rsDos, fso)  
            End If  
        Else  
            Call ParcourirDossiers(disk, dossier, rsDos, fso)  
        End If  
    End If  
    rsDisk.MoveNext  
Loop  
  
rsDisk.Close  
rsDos.Close  
Set db = Nothing  
Set fso = Nothing  
Exit Sub  
  
' \*\*\* Si des dossiers sont inscrit dans la table t\_DOSSIERS  
' \*\*\* mais n'existent plus sur le disque, mettre à jour  
VerifierEtSupprimerDossiers  
  
' \*\*\* Mettre à jour l'affichage de sfrm\_DOSSIERS  
Forms!frm\_MENU!sfrm\_DOSSIERS.Requery  

GestionErreur:
MsgBox "Erreur : " & Err.Number & " - " & Err.Description
Resume Next
End Sub
' =+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
Sub ParcourirDossiers(disk As Variant, dossier As Object, rsDossiers As DAO.Recordset, fso As Object)
Dim sousDossier As Object
Dim tailleMo As Double

On Error GoTo GestionErreur  
  
' \*\*\* Enregistrer les informations du dossier dans la table  
rsDossiers.AddNew  
rsDossiers!dossier = dossier.Name  
rsDossiers!Disque = Left(dossier.Path, 1)  
rsDossiers!Chemin\_Complet = dossier.Path  
'rsDossiers!Taille = dossier.Size  

Debug.Print "Dossier en erreur n° 70 : " & dossier.Path
tailleMo = dossier.Size / 1048576
rsDossiers!Taille = Round(tailleMo, 2)
rsDossiers!Date_Creation = dossier.DateCreated
rsDossiers!Dernier_Acces = dossier.DateLastAccessed
rsDossiers.Update

' \*\*\* Parcourir les sous-dossiers  
For Each sousDossier In dossier.SubFolders  
    Call ParcourirDossiers(disk, sousDossier, rsDossiers, fso)  
Next sousDossier  
  
Exit Sub  
  

GestionErreur:
If Err.Number = 70 Then
Resume Next
On Error GoTo 0
End If
Resume Next
On Error GoTo 0
End Sub

Answer 1

Malheureusement je n'arrive pas a coller mon code ici le site m'en empeche, donc je te refere a essayer le code retrouve au: https://www.devhut.net/using-the-file-system-object-fso-for-retrieving-folder-attributes/

Mais, je crois qu'il y a autre chose en jeux ici.

Answer 2

Bonjour Daniel,
j'ai toujours cette erreur 70 sur un dossier ou un sous-dossier, il semble cette erreur 70 ne correspond pas à un attribut 2, 4 ou 2048
Je ne vois pas comment "sauter" ce dossier que je ne veux pas lire !

Je cherche à tester si le dossier correspond à ReadOnly (1)
Merci Daniel, mais si tu as une idée ... je suis à l'écoute !

Answer 3

Un grand merci Daniel !

Je vais "tenter" d'incorporer cela dans ma programmation et tester !
Je me permettrait de vous tenir informer du ou des résultats !
Merci encore,
Jacques

Answer 4

Voici comment je m'y prendrais

' Normal = 0: Folders with no special attributes.
' ReadOnly = 1: Read-only folders.
' Hidden = 2: Hidden folders.
' System = 4: System folders.
' Directory = 16: This attribute is always set for folders (read-only).
' Archive = 32: Folders that have changed since the last backup.
' Compressed = 2048: Compressed folders (read-only).
Sub CheckFolderAttributes()
Dim fso As Object
Dim folder As Object
Const folderPath = "C:\Windows"
Dim attr As Long

Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder(folderPath)  

attr = folder.Attributes  
Debug.Print attr  
If (attr And 1) Or (attr And 2) Or (attr And 4) Or (attr And 2048) Then  
    Debug.Print folder.Name  
Else  
    Debug.Print "Attribute 1,2,4 or 2048 found."  
End If  

End Sub

Aussi, tu peux utiliser la fonction GetAttr() => GetAttr("C:\Windows")

Il y a aussi le API GetFileAttributes et GetFileAttributesEx que tu pourrais explorer.