Loop à travers des sous-dossiers

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.

dossier

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 Sub

Merci 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
Rechercher des sujets similaires à "loop travers dossiers"