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
64
65
66
67
68
69
70
| Sub A2__Lister_Adresses_Std()
'Remplit la feuille "Adresses_Std" avec l'adresse de tous les fichiers liés aux supports standards
flocal = "Liste_NDC_Passage_BPE_V3.xls"
freseau = "Liste NDC_Passage BPE.xls"
Application.ScreenUpdating = False
Workbooks(flocal).Activate
Worksheets("Adresses_Std").Activate
Range("A3:A10000").ClearContents
rep = Cells(1, 2).Value
Debug.Print
Debug.Print "--------------------------------------------------------------------------------------------------"
Debug.Print "DEBUT:Lister_Adresses_Std"
Debug.Print "Recherche de toutes les notes de calculs liées à un support standard"
Debug.Print "à partir du répertoire:" & rep
k = 3
Set fs = ClFileSearch.Nouvelle_Recherche
With fs
.FolderPath = rep
'If Trim(.LookIn) = "" Then
'MsgBox "Mettre l'adresse du répertoire en B1 de la feuille FICHIER!"
'Else
.SubFolders = True
'.FileType = msoFileTypeExcelWorkbooks
.Extension = "*.xls"
Debug.Print "", "-"
If .Execute() > 0 Then
For i = 1 To .FoundFilesCount
If i Mod 500 = 0 Then
Debug.Print "", "-"
End If
If InStr(.Files(i), "\S-") <> 0 Then '<-- (erreur de type13)
Range("B" & CStr(k)) = .Files(i)
Table = Split(.Files(i), "\S-")
Range("A" & CStr(k)) = "S-" & Table(1)
'k = k + 1
End If
Next
Else
MsgBox "Aucun fichier trouvé"
End If
'End If
End With
Max = Cells(65536, 1).End(xlUp).Row
Range("A3:B" & CStr(Max)).Sort _
Key1:=Range("A3"), _
Order1:=xlDescending
Debug.Print "FIN:Lister_Adresses_Std"
Debug.Print "--------------------------------------------------------------------------------------------------"
Application.ScreenUpdating = True
End Sub |
