Microsoft 365 récupérer nom des dossiers

J

julien1982

XLDnaute Occasionnel
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.
 
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Julien,
julien1982 à dit:
je récupère le nom des dossiers manuellement.
Cliquez pour agrandir...
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 ?
 
Vote positif 0 Vote négatif
J

julien1982

XLDnaute Occasionnel
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) ?
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
J

julien1982

XLDnaute Occasionnel
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 ?
Cliquez pour agrandir...
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
1698822133182.png
1698822281951.png
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
Cliquez pour agrandir...
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.
 

Pièces jointes

  • Julien.xlsm
    17 KB · Affichages: 1
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
J

julien1982

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Bonjour patrickloulon,

merci ca marche top.

Merci egalement a toi Sylvanu, ca fonctionne aussi au top.
 
Vote positif 0 Vote négatif
J

julien1982

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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.
 

Pièces jointes

  • Classeur1.xlsm
    23.2 KB · Affichages: 4
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
J

julien1982

XLDnaute Occasionnel
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
Cliquez pour agrandir...
La date du jour me sert uniquement d'alerte pour savoir si on est en retard ou non sur les réponses aux AO.
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
XL 2019 Macro pour recuperer les noms de dossiers
Réponses
2
Affichages
288
julien1982
J
J
  • Question
XL 2021 reporter des données entre plusieurs feuilles sans décalage de lignes dans les tableaux
Réponses
4
Affichages
376
job75
job75
M
  • Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
543
macseb
M
Darkopsix
  • Résolu(e)
XL 2021 Récupérer des données de fichiers dons les noms sont renseignés dans des cellules
Réponses
2
Affichages
422
Darkopsix
Darkopsix
K
  • Question
Autres 'Resolu' 'Nettoyer' des lignes par une macro
Réponses
7
Affichages
238
klorane
K
C
  • Question
XL 2019 Graphique suivi Appel d'offres
Réponses
2
Affichages
1 K
Efgé
Efgé
A
  • Question
XL 2016 Compter nombre de fichiers présent dans des répertoires
Réponses
6
Affichages
787
merinos
merinos
Dadi147
  • Résolu(e)
XL 2016 Récupérer les données de nom et de date VBA
2 3
Réponses
35
Affichages
2 K
Oneida
Oneida
P
  • Question
XL 2016 Mise en place d'une étude hebdomadaire des remarques 5S - Bascule d'information entre 3 fichiers
Réponses
10
Affichages
802
gbinforme
G
M
  • Résolu(e)
XL 2013 Mémoriser le dernier emplacement de sauvegarde
Réponses
9
Affichages
766
M.Ben
M

Membres actuellement en ligne

14 membres et 132 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 207
Messages
2 086 237
Membres
103 162
dernier inscrit
fcfg