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 |
Partager