Loop à travers des sous-dossiers
P
Bonjour,
Je fais un tableau suivi des commandes de clients.
Un macro a été développée pour aller chercher l'information dans chaque dossier des clients mais certains clients ont fusionné et cela ne fonctionne plus.
Je ne sais pas comment je peux faire une loop à travers tous les sous-dossiers. Je devrais changer la ligne ci-dessous, mais je vois pas comment faire.
fichier = dossier & "\" & numOrdre & ". " & client & "\3. Reporting\" & numOrdre + " " + client + " " + annee + " - Dettes commerciales.xlsx"Sub updateData()
Dim src As Workbook
Dim dossier As String
Dim fichier As String
Dim fichierExiste As String
Dim numOrdre As String
Dim annee As String
Dim uap As String
dossier = Range("N1").Value
annee = Range("A6").Value
Debug.Print dossier & annee
i = 11
Do While i < 150
numOrdre = Range("A" & i).Value
client = Range("E" & i).Value
fichier = dossier & "\" & numOrdre & ". " & client & "\3. Reporting\" & numOrdre + " " + client + " " + annee + " - Dettes commerciales.xlsx"
fichierExiste = Dir(fichier)
If fichierExiste <> "" Then
Debug.Print fichier
Set src = Workbooks.Open(fichier, True, True)
Range("I" & i).Value = src.Worksheets(1).Range("B3").Value
Range("J" & i).Value = src.Worksheets(1).Range("B4").Value
Range("K" & i).Value = src.Worksheets(1).Range("B6").Value
Range("L" & i).Value = src.Worksheets(1).Range("B7").Value
Range("M" & i).Value = src.Worksheets(1).Range("B8").Value
Dim FSO As Object
Dim File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.GetFile(src.FullName)
dateFichierUap = Format(File.DateLastModified, "dd/MM/yyyy")
dateAComparer = Range("N2").Value
Set FSO = Nothing
Range("H" & i).Value = dateFichierUap
If (DateValue(dateAComparer) < DateValue(dateFichierUap) Or DateValue(dateAComparer) = DateValue(dateFichierUap)) Then
Range("G" & i).Value = "OK"
Else
Range("G" & i).Value = ""
End If
src.Close
End If
i = i + 1
Loop
End SubMerci d'avance
bonsoir,
une proposition (non testée)
Sub updateData()
Dim src As Workbook
Dim dossier As String
Dim fichier As String
Dim fichierExiste As String
Dim numOrdre As String
Dim annee As String
Dim uap As String
Dim FSO As Object
Dim File As Object
Set tws = ActiveSheet
dossier = Range("N1").Value
annee = Range("A6").Value
Debug.Print dossier & annee
i = 11
Set FSO = CreateObject("Scripting.FileSystemObject")
Set rep = FSO.getfolder(dossier)
Do While i < 150
numOrdre = tws.Range("A" & i).Value
If numOrdre <> "" Then
client = tws.Range("E" & i).Value
For Each srep In rep.subfolders
If InStr(srep.Name, numOrdre & "." & client) > 0 Then
fichier = dossier & "\" & srep.Name & "" & "\3. Reporting\" & numOrdre + " " + client + " " + annee + " - Dettes commerciales.xlsx"
Set File = FSO.GetFile(fichier)
If Not File Is Nothing Then
Debug.Print fichier
Set src = Workbooks.Open(fichier, True, True)
tws.Range("I" & i).Value = src.Worksheets(1).Range("B3").Value
tws.Range("J" & i).Value = src.Worksheets(1).Range("B4").Value
tws.Range("K" & i).Value = src.Worksheets(1).Range("B6").Value
tws.Range("L" & i).Value = src.Worksheets(1).Range("B7").Value
tws.Range("M" & i).Value = src.Worksheets(1).Range("B8").Value
dateFichierUap = Format(File.DateLastModified, "dd/MM/yyyy")
dateAComparer = tws.Range("N2").Value
tws.Range("H" & i).Value = dateFichierUap
If (DateValue(dateAComparer) < DateValue(dateFichierUap) Or DateValue(dateAComparer) = DateValue(dateFichierUap)) Then
tws.Range("G" & i).Value = "OK"
Else
tws.Range("G" & i).Value = ""
End If
src.Close
Exit For
End If
End If
Next
End If
i = i + 1
Loop
End Sub