Microsoft 365 récupérer nom des dossiers

[julien1982]

Bonjour a toutes et tous,

merci déjà pour votre aide et ce forum.
Je possède un petit fichier de suivi d'appel d'offre, et actuellement je récupère le nom des dossiers manuellement.
Je souhaiterai que cela devienne automatique en vérifiant ceux déjà présents, et ajoutant le nom des nouveaux dossiers à mon listing.

Dans l’idéal, il faudrait que je puisse aller pointer l'endroit ou sont les dossiers.

Ci joint le fichier.

 

[patricktoulon]

re

Sub test()
    Dim Liste, Folder

    Folder = GetOpenFolderName2: If Folder = "" Then Exit Sub

    Liste = GetFolderList(Folder)

    If IsArray(Liste) Then Cells(2, 1).Resize(UBound(Liste), 2) = Liste

    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields. _
            Add Key:=Range("Tableau1[[#All],[Nom AO]]"), SortOn:=xlSortOnValues, Order _
                                                                               :=xlAscending, DataOption:=xlSortNormal
End Sub

'la boite de dialogue de selection du dossier maitre
Function GetOpenFolderName2() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then GetOpenFolderName2 = .SelectedItems(1)
    End With
End Function

'la fonction renvoie un tableau des noms des dossier(si il y en a )
Function GetFolderList(FolderParent) As Variant
'patricktoulon:developpez.com
    Dim t(), a&, P$
    P = Dir(FolderParent & "\", vbDirectory)
    Do While P <> ""
        If (GetAttr(FolderParent & "\" & P) = vbDirectory) And Left(P, 1) <> "." Then
            a = a + 1: ReDim Preserve t(1 To 2, 1 To a): t(1, a) = P
            If IsDate(Left(P, 10)) Then t(2, a) = CDate(Left(P, 10))
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

 

[julien1982]

re

Sub test()
    Dim Liste, Folder

    Folder = GetOpenFolderName2: If Folder = "" Then Exit Sub

    Liste = GetFolderList(Folder)

    If IsArray(Liste) Then Cells(2, 1).Resize(UBound(Liste), 2) = Liste

    ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields. _
            Add Key:=Range("Tableau1[[#All],[Nom AO]]"), SortOn:=xlSortOnValues, Order _
                                                                               :=xlAscending, DataOption:=xlSortNormal
End Sub

'la boite de dialogue de selection du dossier maitre
Function GetOpenFolderName2() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then GetOpenFolderName2 = .SelectedItems(1)
    End With
End Function

'la fonction renvoie un tableau des noms des dossier(si il y en a )
Function GetFolderList(FolderParent) As Variant
'patricktoulon:developpez.com
    Dim t(), a&, P$
    P = Dir(FolderParent & "\", vbDirectory)
    Do While P <> ""
        If (GetAttr(FolderParent & "\" & P) = vbDirectory) And Left(P, 1) <> "." Then
            a = a + 1: ReDim Preserve t(1 To 2, 1 To a): t(1, a) = P
            If IsDate(Left(P, 10)) Then t(2, a) = CDate(Left(P, 10))
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

Super ça fonctionne, y a quelques dates ou il inverse le mois et le jour (ligne 6 par exemple 04/07/2023 au lieu de 07/04/2023) mais sinon ça fonctionne.

Possible de m'expliquer comment cela marche pour la récupération de la date?

 

[patricktoulon]

ben je teste les 10 premiers caractères du nom
"xxx-xx-xx"
si cette chaine chaine de 10 caractères est une date valide(quelque soit le format ) je l'inscrit dans la colonne 2 avec Cdate pour convertir en date au format français
Tout simplement

 

[patricktoulon]

re
non il ne peut pas inverser
en fait c'est que ta cellule a été formatée par une date insérée précédemment en anglais
sélectionne toute la colonne et met le format français
Tout simplement

 

[julien1982]

re
non il ne peut pas inverser
en fait c'est que ta cellule a été formatée par une date insérée précédemment en anglais
sélectionne toute la colonne et met le format français
Tout simplement

Pourtant les dates sont bien en français mais ça bug...
même en partant d'un fichier vierge