Sub Aspi1()
'Déclaration variables Objects parcours de répertoire
Dim Fso As Scripting.FileSystemObject, Rep As String
Dim f1 As Object, f2 As Object
Dim OF As String
Dim Produit As Variant
Dim SE As Variant
Dim NomIcomplet As String
Dim i As Long
Dim src As Workbook
Set src = Workbooks.Open("C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND\01 - Modèle\SuiviCND.xlsm", True, True)
ThisWorkbook.Activate
i = 2
Do While Cells(i, 4) <> "" ' compteur de ligne colonne CHILD OP/PRODUCT
OF = Cells(i, 4) 'CHILD OP
Produit = Mid(Cells(i, 5), 8, 6) 'CHILD PRODUCT
SE = Right(Cells(i, 5), Len(Cells(i, 5)) - 14) 'S/N
Rep = "C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND" & "\" 'Définit le répertoire contenant les fichiers
Set Fso = CreateObject("Scripting.FileSystemObject")
For j = 7 To 10 'compteur colonne VT/PT/MT/UT "Aspirateur"
Cells(i, j) = ""
TEST = Cells(1, j)
NomIncomplet = OF & "-" & TEST & "-" & Produit & "-" & SE & "-"
For Each f1 In Fso.GetFolder(Rep).SubFolders ' Dans le dossier
For Each f2 In f1.Files 'et chaque sous dossiers
If f2.Name Like "*" & NomIncomplet & "*" = True Then ' Si le fichier cherché egal au N°OF
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
Cells(i, j) = f2.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, j), _
Address:=f2.ParentFolder & "\" & f2.Name
MonApp.Open (Chemin)
Set MonApplication = Nothing
Present = 1
GoTo 10:
Else
FinCol = src.Sheets("Suivi_CND").Range("F65536").End(xlUp).Row 'dernière ligne N°CodeArticle
For L = 2 To FinCol
Set PlageCodeArticle = src.Sheets("Suivi_CND").Cells(L, 6) 'colonne N°codearticle
Set Trouve = PlageCodeArticle.Cells.Find(what:=Produit, LookAt:=xlWhole)
If Trouve Is Nothing Then 'Si Produit différent de Code article
Cells(i, j) = "Erreur N°produit"
GoTo 10:
Else 'Si Produit=CodeArticle
For Each Produit In PlageCodeArticle
FinCol1 = src.Sheets("Suivi_CND").Range("J65536").End(xlUp).Row 'dernière ligne N°Série
For K = 2 To FinCol1
Set PlageSerie = src.Sheets("Suivi_CND").Cells(K, 10) 'colonne N°Serie
Set Trouve1 = PlageSerie.Cells.Find(what:=SE, LookAt:=xlWhole)
If Trouve1 Is Nothing Then 'Si SE différent de Série
Cells(i, j) = "Erreur N°Série"
Else 'Si SE=Serie
For Each SE In PlageSerie
HistCND = src.Sheets("Suivi_CND").Cells(K, 15)
If HistCND = "N/A" Then
Cells(i, j) = "N/A"
Else
Cells(i, j) = "FAIT"
End If
Next SE
End If
Next K
Next Produit
End If
Next L
End If
Next f2
Next f1
10:
Next j
i = i + 1
Loop
src.Close False
Set src = Nothing
End Sub