Microsoft 365 Récupérer liste nom de dossier sur cellule en boucle

[pulelian]

Bonjour,

Je souhaite récupérer les noms des dossiers sur les cellules de la colonne 9, à la suite.
Je tourne pas mal mon soucis dans tout les sens, mais je ne parviens pas à trouver pourquoi ce code marché avant mais plus maintenant :

Sub Dossier_BDD_Doc_maj()
Sheets("DOC_Aide classement").Select
'1-déprotéger onglet avec mot de passe + code
ActiveSheet.Unprotect password
'""""""""""""""""""""""""""""""""""""""""""""DEPROTEGER"

'récupère nom dossier sous ..
Application.ScreenUpdating = False


Dim myPath As String, myFolder As String
Dim i As Integer


myPath = ThisWorkbook.Path & "\A. FINANCE ET ADMIN"
myFolder = Dir(myPath & "\*", vbDirectory)

i = 1
Do While myFolder <> ""

If GetAttr(myPath & "\" & myFolder) = vbDirectory Then
Cells(i, 9) = myFolder
i = i + 1

End If
myFolder = Dir()

Loop
'--
'End sub





Vu mes 2 espions cela a l'air d'être bon. Je déprotège ma feuille pour éxécution du code aussi.

Si quelqu'un passe par là, je lui remercie d'avance.


merciiii

 

[Phil69970]

Bonjour @pulelian, le forum

A priori ce bout de code ne fonctionnera jamais si tu as un mdp

ActiveSheet.Unprotect password

Mais celui ci fonctionne

ActiveSheet.unprotect password "Toto"   '<== à adapter

'Le reste de ton code....
'Blablabla
'Et je reprotege avec un MDP

ActiveSheet.protect password "Toto"   '<== à adapter
end sub

Merci de ton retour

@Phil69970

 

[fanch55]

Bonjour à tous,

Excel 2019 : pas de problème particulier avec votre macro, elle fonctionne parfaitement bien .

Cependant, pour avoir connu bien de déboires avec la fonction Dir, j'utilise plutôt le FileSystemObject .
Votre Macro serait ainsi adaptée :

Sub test()
Dim Fso As Object, SubFolder As Object
Dim MyPath As String, L As Integer, NbChamps As Integer

NbChamps = 2 ' On va récupérer Nbchamps Infos

    ActiveSheet.Unprotect Password
    Columns("I").Resize(, NbChamps).ClearContents
    MyPath = ThisWorkbook.Path & "\A. FINANCE ET ADMIN\"
    Set Fso = CreateObject("Scripting.FileSystemObject")
        If Fso.FolderExists(MyPath) Then
            L = 1
            For Each SubFolder In Fso.getfolder(MyPath).subfolders
                Cells(L, "I").Resize(, NbChamps) = _
                    Array(SubFolder.DateLastModified, SubFolder.Name)
                L = L + 1
            Next
        Else
            MsgBox MyPath & " n'existe pas", vbCritical + vbOKOnly
        End If
    Set Fso = Nothing
    Columns("I").Resize(, NbChamps).AutoFit
              
End Sub

Nota: elle peut vous donner plus d'information que Dir.