VBA Parcourir liste dossier par ordre alphabétique

Bonjour à tous,

j'aimerais parcourir une liste de dossiers situés sur un sharepoint, par ordre alphabétique. J'aimerais pouvoir faire ça sans télécharger ces dossiers, uniquement en réalisant un parcours sur le sharepoint. Je possède une macro (voir plus bas) qui fonctionne très bien et qui fait exactement ce que je souhaite, excepté ce parcours de dossiers dans l'ordre alphabétique (d'ailleurs je ne sais même pas dans quel ordre elle parcourt les dossiers. Ces dossiers là étant triés par ordre alphabétique sur le SharePoint lorsque j'éxécute la macro).

Mon code est le suivant:

 Dim i As Long

Sub Consolider_Simu3()
    Dim S_Commande As Worksheet
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainSheet = ThisWorkbook.Sheets("Simulations")
    BoucleFichiers = 0

   For Each Dossier In Fso.GetFolder(Chemin).SubFolders

        For Each Fichier In Dossier.Files

            If Left(Fichier.Name, 11) = "SIMULATION_" Then

            Set WB_TargetFichier = Workbooks.Open(Dossier & "\" & Fichier.Name)
            Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
            TargetSheet.Range("F6:G13").Select
            Selection.Copy
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            i = i + 22
            BoucleFichiers = BoucleFichiers + 1

            WB_TargetFichier.Close savechanges:=False

            End If

        Next Fichier

    Next Dossier
End Function

J'ai surligné le moment où je lui demande de parcourir les différents dossiers de mon répertoire SharePoint pour que vous puissiez identifier plus facilement l'endroit où je souhaite agir.

Quelqu'un a-t-il une proposition/idée à me soumettre ?

Bon week-end à tous !

SkillzZ

Bonjour,

une possibilité est de mettre tous les chemin dans une variable objet "System.Collections.ArrayList"

par exemple,

Dim AL1 As Object
Set AL1 = CreateObject("System.Collections.ArrayList")
'................
 For Each Fichier In Dossier.files
      AL1.Add Range(Fichier)
 Next

   AL1.Sort  'tri par ordre alpha
   r = AL1.Toarray()

   For i = LBound(r) To UBound(r)
       If Left(Fichier.Name, 11) = "SIMULATION_" Then
'................

Bonjour à tous, bonjour SabV,

je vais essayer ça, je t'en dis des nouvelles dans la matinée ! Merci beaucoup !

Excellente journée à toi !

SkillzZ

Bonjour SabV, j'aurais besoin d'un coup de main pour implémenter ta solution dans mon code..

J'ai essayé mais je n'y suis pas parvenu. Pour commencer je pense que tu as voulu trier les "Fichier" par ordre alphabétique alors que c'est les dossiers que je souhaite trier. Donc j'ai effectué cette modification. Mais je ne suis pas parvenu à obtenir le résultat souhaité. Je suis arrivé au code suivant:

 Dim i As Long

Sub Consolider_Simu3()
    Dim S_Commande As Worksheet
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)
    MsgBox (Nb & "groupements de données importés")

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet
    Dim AL1 As Object

    Set AL1 = CreateObject("System.Collections.ArrayList")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainSheet = ThisWorkbook.Sheets("Simulations")
    BoucleFichiers = 0

    For Each Dossier In Fso.GetFolder(Chemin).SubFolders
       AL1.Add Dossier
    Next Dossier

 AL1.Sort  'tri par ordre alpha
    r = AL1.Toarray()

    For i = LBound(r) To UBound(r)

            For Each Fichier In Dossier.Files

                If Left(Fichier.Name, 11) = "SIMULATION_" Then

                Set WB_TargetFichier = Workbooks.Open(Dossier & "\" & Fichier.Name)
                Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
                TargetSheet.Range("F6:G13").Select
                Selection.Copy
                MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
                MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
                i = i + 22
                BoucleFichiers = BoucleFichiers + 1

                WB_TargetFichier.Close savechanges:=False

                End If

            Next Fichier

    Next
End Function

Mais avec ce code j'ai un message d'erreur: Impossible de comparer deux éléments dans le tableau. Peut-être que je dois spécifier au niveau du "Sort" qu'il faut trier les noms de dossiers et non les dossiers tout court ? Pourrais-tu m'aider ?

Merci d'avance,

SkillzZ

Bonjour SkillzZ ,

suite à l'exécution de la macro je vois que Windows a déjà fait le tri de la liste des dossiers,

alors nul besoin de le faire une 2ème fois, ce n'est pas le cas sur ton pc ?

Bonjour SabV, lorsque j'éxécute ma macro les dossiers du SharePoint ne sont pas lus dans l'ordre d'alphabétique non.. Je parle bien des dossiers et non des fichiers excel. Pour le vérifier j'ai fais écrire dans une colonne les noms des dossiers et j'ai pu confirmé qu'ils n'étaient pas lu dans le bon ordre..

ok, je vois que ":" du chemin pause problème, je l'sai enlever puis remit,

Dim i As Long

Sub Consolider_Simu3()
    Dim S_Commande
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)
    MsgBox (Nb & "groupements de données importés")

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet
    Dim AL1 As Object
    Dim ch As String
    Dim d0 As String
    Dim d1 As String

    Set AL1 = CreateObject("System.Collections.ArrayList")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainSheet = ThisWorkbook.Sheets("Simulations")
    BoucleFichiers = 0

    For Each Dossier In Fso.GetFolder(Chemin).SubFolders
     d0 = Left(Dossier, 3)
     d1 = Right(Dossier, Len(Dossier) - 3)
       AL1.Add d1
    Next Dossier

    AL1.Sort  'tri par ordre alpha
    r = AL1.Toarray()

    For i = LBound(r) To UBound(r)
         ch = d0 & r(i)
            For Each Fichier In Fso.GetFolder(ch).Files
              fich = ch & Fichier
              Debug.Print ch

              ' execution du travail à faire

                BoucleFichiers = BoucleFichiers + 1
            Next Fichier

    Next i
Set ALI = Nothing
End Function

Bonjour SabV !

Ce que tu as fait est génial et fonctionne parfaitement je te remercie beaucoup, ça va m'être très utile! Merci pour le temps passé sur mon problème, je m'en souviendrais ! Je n'ai pas compris tout ton code mais je vais bosser dessus pour essayer de le comprendre et être en mesure de le refaire !

Je te souhaite une bonne journée !

SkillzZ

Rechercher des sujets similaires à "vba parcourir liste dossier ordre alphabetique"