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

pulelian · 19 Août 2021

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 · 19 Août 2021

Bonjour @pulelian, le forum

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

pulelian à dit:
ActiveSheet.Unprotect password

Mais celui ci fonctionne

VB:

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 · 19 Août 2021

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 :

VB:

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.

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

pulelian

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Discussions similaires