Microsoft 365 récupérer nom des dossiers

julien1982 · 31 Octobre 2023

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.

sylvanu · 31 Octobre 2023

Bonjour Julien,

julien1982 à dit:
je récupère le nom des dossiers manuellement.

Comment faites vous pour faire la corrélation entre un intitulé et un nom de fichier ?
Par ex, pour "Puyoo-Bayonne_Retrait_Revêt_Bitumineux_Amiante" correspond il un fichier nommé "Puyoo-Bayonne_Retrait_Revêt_Bitumineux_Amiante.xlsx" dans un dossier ?
Sinon comment faites vous ?
Tous vos fichiers sont ils dans un même dossier ?

sylvanu · 31 Octobre 2023

Donc le nom du dossier est constitué par la date de la colonne B suivi de la désignation colonne A ?
Par ex pour "Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17)" je vais trouver un dossier nommé :
2023-06-02_Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17) ?

julien1982 · 31 Octobre 2023

sylvanu à dit:
Donc le nom du dossier est constitué par la date de la colonne B suivi de la désignation colonne A ?
Par ex pour "Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17)" je vais trouver un dossier nommé :
2023-06-02_Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17) ?

Pr la date je le ferai via une formule. Si déjà j arrie à récupérer le nom de dossier comme il est écrit sur le serveur ça sera déjà un bon début.

sylvanu · 31 Octobre 2023

julien1982 à dit:
Si déjà j arrie à récupérer le nom de dossier comme il est écrit sur le serveur ça sera déjà un bon début.

Oui mais pour trouver ce dossier il faut connaitre son nom.
Donc à partir de cette chaine "Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17)" que doit on chercher ?

julien1982 · 1 Novembre 2023

sylvanu à dit:
Oui mais pour trouver ce dossier il faut connaitre son nom.
Donc à partir de cette chaine "Travaux Régé (Hors Suite) 2023-1 RVB La Rochelle (17)" que doit on chercher ?

En gros,
je souhaite aller chercher dans un dossier tous les sous dossiers avec leur noms complets

Exemple, dans le dossier "toto" que je vais pointer par un boite de dialogue, je veux récupérer et inscrire dans la colonne A1 tous les noms des sous dossiers quelques soit leur noms..."toto_1", toto-2, etc etc..."travaux.....(17"....etc etc...

Je sais si j'ai été clair.

Exemple ci dessous:

Je vais pointer le dossier "Dossier_1" et ca me recuperer le nom de chaque dossier tels qu'ils sont dans la colonne A

sylvanu · 1 Novembre 2023

Bonjour Julien,
Cette demande n'a rien à voir avec la demande initiale :

julien1982 à dit:
Je souhaiterai que cela devienne automatique en vérifiant ceux déjà présents, et ajoutant le nom des nouveaux dossiers à mon listing.

Pour vérifier il fallait la date, la construction du nom des dossiers ...
En PJ une réponse à votre post #6. Avec :

VB:

Sub ListeDossiers()
    Dim objFSO As Object, objFolder As Object, objSubFolder As Object, objFile As Object
    Dim folderPath$, rowNum%
    [A:A].ClearContents                                     ' Vide col résultat
    Application.ScreenUpdating = False
    folderPath = SelectDossier                              ' Choix du dossier
    If folderPath = "" Then MsgBox "Pas de dossier choisi": Exit Sub
    Set objFSO = CreateObject("Scripting.FileSystemObject") ' Crée un objet FileSystemObject
    rowNum = 1                                              ' Initialise le N° de ligne
    If objFSO.FolderExists(folderPath) Then                 ' Vérifie si le dossier existe
        Set objFolder = objFSO.GetFolder(folderPath)        ' Ouvre le dossier
        For Each objSubFolder In objFolder.Subfolders       ' Parcourt sous-dossier
            Cells(rowNum, 1).Value = objSubFolder.Name      ' Affiche le nom
            rowNum = rowNum + 1
        Next objSubFolder
        Set objSubFolder = Nothing: Set objFolder = Nothing: Set objFSO = Nothing ' Nettoyage
    Else
        MsgBox "Le dossier spécifié n'existe pas."          ' Si erreur
    End If
    [A:A].Resize(10000).Sort key1:=[A1], order1:=xlAscending, Header:=xlNo  ' Tri alpha des noms dossiers
End Sub
Function SelectDossier$(Optional Titre$ = "Choisissez le dossier et cliquez sur le bouton ""Choix Dossier""")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Choix Dossier"
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = Titre: .Show
        If .SelectedItems.Count > 0 Then SelectDossier = .SelectedItems(1)
    End With
End Function

Cela fait ce qui est demandé au post #6 mais pas au post #1.

patricktoulon · 1 Novembre 2023

bonjour

VB:

Sub test()
    Dim Liste, Folder

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

    Liste = GetFolderList(Folder)

    If IsArray(Liste) Then Cells(1, 1).Resize(UBound(Liste)) = Liste
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 a): t(a) = P
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

julien1982 · 1 Novembre 2023

patricktoulon à dit:

bonjour

VB:

Sub test()
    Dim Liste, Folder

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

    Liste = GetFolderList(Folder)

    If IsArray(Liste) Then Cells(1, 1).Resize(UBound(Liste)) = Liste
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 a): t(a) = P
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

Bonjour patrickloulon,

merci ca marche top.

Merci egalement a toi Sylvanu, ca fonctionne aussi au top.

julien1982 · 2 Novembre 2023

patricktoulon à dit:

bonjour

VB:

Sub test()
    Dim Liste, Folder

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

    Liste = GetFolderList(Folder)

    If IsArray(Liste) Then Cells(1, 1).Resize(UBound(Liste)) = Liste
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 a): t(a) = P
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

Bonjour a tous,

après vérification au calme les macros fonctionnent pas de soucis, par contre il faudrait que cela n’écrase pas la ligne 1 car j'ai des titres de colonnes.

Ensuite, une fois que cela a été récupéré, je souhaite que dans la colonne B, se mette la date qui est en début de la colonne A (par exemple "23-02-2023") pour me permettre ensuite de suivre via une MFC si la date est dépassé ou non.
ci joint le fichier commenté.

Merci encore pour votre aide.

patricktoulon · 2 Novembre 2023

re
je ne vois pas trop l'intérêt de la date du jour mais bon

VB:

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: t(2, a) = Date
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

julien1982 · 2 Novembre 2023

patricktoulon à dit:

re
je ne vois pas trop l'intérêt de la date du jour mais bon

VB:

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: t(2, a) = Date
        End If
        P = Dir
    Loop
    If a > 0 Then GetFolderList = Application.Transpose(t)
End Function

La date du jour me sert uniquement d'alerte pour savoir si on est en retard ou non sur les réponses aux AO.

patricktoulon · 2 Novembre 2023

ok
bon ben voila

julien1982 · 2 Novembre 2023

patricktoulon à dit:
ok
bon ben voila

Je vais tester ça. Merci en tt cas

julien1982 · 2 Novembre 2023

julien1982 à dit:
Je vais tester ça. Merci en tt cas

Re bonjour,

dans ton code, il inscrit la date du jour dans la cellule B, hors moi je veux qu'il inscrive la date écrite en début de nom écrit dans la cellule A (voir capture)

Microsoft 365 récupérer nom des dossiers

julien1982

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

julien1982

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

julien1982

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

julien1982

XLDnaute Occasionnel

julien1982

XLDnaute Occasionnel

Pièces jointes

patricktoulon

XLDnaute Barbatruc

julien1982

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

julien1982

XLDnaute Occasionnel

julien1982

XLDnaute Occasionnel

Pièces jointes

Discussions similaires