Désordre avec macros de recherche récursive
Bonjour, :D
Je suis nouveau sur le forum et j'ai une question pointu pour les spécialistes du VBA. J'utilise plusieurs macros différentes pour lister depuis une feuille Excel 2013 , les sous-dossiers et leurs fichiers respectifs d'un dossier ciblé. Je récupère juste les noms des dossiers et des fichiers. L'arborescence se trouve sur un serveur Windows. j'ai constaté que le résultat de la recherche récursive ne respecte pas du tout l'ordre des dossiers et des fichiers de l'arborescence se trouvant sur le serveur. En revanche, lorsque je copie la même arborescence en local sur mon pc (windows 8, Excel 2013), la macro me présente parfaitement tous les dossiers et fichiers dans l'ordre de tri d'origine.
Pourquoi cette différence ? Quelqu'un a t'il eu le même problème. Comment y remédier car au final la macro doit scanner des dossiers sur une zone d'échange du serveur et non sur mon PC en local. je sèche à ce niveau.
J'ai fait le test avec une macro que j'ai trouvé sur le forum et j'obtiens le même résultat : la liste obtenu des sous-dossiers et fichiers (PDF) n'est pas dans l'ordre du tri d'origine lorsque la macro pointe sur un dossier du serveur. Par contre, le résultat est niquel lorsque la macro pointe sur une copie conforme de l'arborescence en local sur mon pc. Voici la macro de test :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Dim NbFichiers As Long, NbDossiers As Long
Dim Dep As Currency, Fin As Currency, Freq As Currency
Private Sub Liste(ByVal sChemin As String, ByVal bSousDossier As Boolean)
Dim FSO As Object, Dossier As Object, SousDossier As Object, Fichier As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(sChemin)
Fichier = Dir$(sChemin & "\*.*")
Do While Len(Fichier) > 0
NbFichiers = NbFichiers + 1
With ShFichiers
.Cells(NbFichiers, 1) = sChemin
.Cells(NbFichiers, 2) = Fichier
End With
Fichier = Dir$()
Application.StatusBar = "Dossiers : " & NbDossiers & " Fichiers : " & NbFichiers
Loop
If bSousDossier Then
For Each Dossier In Dossier.SubFolders
NbDossiers = NbDossiers + 1
Liste Dossier.Path, True
Next Dossier
End If
Set Dossier = Nothing
Set FSO = Nothing
End Sub
Sub Tst()
Dim sChemin As String
sChemin = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sChemin & "\"
.Title = "Sélectionner un Dossier"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.ButtonName = "Sélection Dossier"
.Show
If .SelectedItems.Count > 0 Then
ShFichiers.Cells.Clear
Application.ScreenUpdating = False
Application.StatusBar = ""
DoEvents
QueryPerformanceCounter Dep
NbFichiers = 0: NbDossiers = 0
Liste .SelectedItems(1), True
Application.ScreenUpdating = True
QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq
Application.StatusBar = "Dossiers : " & NbDossiers & " Fichiers : " & NbFichiers & " / " & Format(((Fin - Dep) / Freq), "0.00 s")
End If
End With
End Sub |
Je précise que le nom d'un dossier ressemble à cela : 09016 filtres (UPLC-UV) et les noms des fichiers ressemble à celà : S42 RK0213L 68594 (KL MIT-T0).pdf. Merci pour vos réponses
Mistral314
