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