Macro à appliquer aux fichiers contenus dans un répertoire

Bonjour à toutes et à tous

A cause d'un problème de sécurité au taf, on est obligé de migrer une tonne de fichiers excel ayant des liens hypertextes en veux-tu en voila.

Vu que la plupart sont des fichiers datant de 2015 et 2016, il suffit que l'on y supprime les liens.

Cette opération les transformera en valeurs (ce qui est parfait).

Le soucis c'est que l'on a environ dans les 10 000 fichiers dans ces répertoires.

Je demande votre aide afin de m’éviter de me taper une telle quantité de fichiers à la main, un par un.

J'ai trouvé cette macro sur un site de Microsoft qui semble déjà faire le travail de suppression de liaisons :

Sub SupprimerLiaisons()
Dim Liaisons As Variant
Liaisons = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

If IsEmpty(Liaisons) = True Then Exit Sub

For LiaisonsTrouvee = 1 To UBound(Liaisons)
ActiveWorkbook.BreakLink _
    Name:=Liaisons(LiaisonsTrouvee), _
    Type:=xlLinkTypeExcelLinks
Next LiaisonsTrouvee

End Sub

A l'heure actuelle, j'utilise une macro qui me permet de lancer "une macro contenu dans certains fichiers afin que ceux-ci actualisent leurs liens" (ceci permet à l'utilisateur final de ne pas le faire lui même).

Sub Actualiser_Synthese()
Dim s2017Folder As String 'chemin du dossier 2017
Dim iWeek As Integer 'num de semaine
Dim oWbk As Excel.Workbook
Dim sErr As String

'effacer le CR de la dernière exécution
ThisWorkbook.Worksheets(1).Range("A1").Value = vbNullString

'le présent classeur doit être placé à côté du dossier 2017
s2017Folder = ThisWorkbook.Path & "\2017"

'scruter les répertoires hebdo
For iWeek = 1 To 52
    On Error Resume Next
        Set oWbk = Application.Workbooks.Open(s2017Folder & "\S" & Format(iWeek, "00") & "\SYNTHESE.xlsm")

        If Err.Number <> 0 Then
            sErr = sErr & vbCrLf & "Le classeur de la semaine " & Format(iWeek, "00") & " n'a pas été trouvé."
        Else
            Application.Run oWbk.Name & "!Actualiser"

            If Err.Number <> 0 Then
                sErr = sErr & vbCrLf & "Le classeur de la semaine " & Format(iWeek, "00") & " n'a pas été mis à jour."
            Else
                DoEvents
                oWbk.Save
            End If

            oWbk.Close
        End If

    On Error GoTo 0
Next iWeek

'CR d'exécution
ThisWorkbook.Worksheets(3).Range("C2").Value = "Mise à jour terminée." & IIf(sErr = vbNullString, " RAS", " Des problèmes sont survenus : " & sErr)

Set oWbk = Nothing

End Sub

J'aurai besoin de votre aide pour :

1 - Modifier le fonctionnement de cette macro. Ici elle travaille en suivant l’arborescence de fichier suivante :

2017\S01\Synthese.xlsm

(S01 correspond à la première semaine de l'année, j'ai donc 52 répertoires : S01,S02,S03, chacun comprenant les mêmes fichiers)

il faudrait que je puisse lui dire en gros :

2017\S01\travail dans tous les sous répertoires

dans le répertoire 2017, j'ai 52 répertoires qui comprennent chacun 5 autres répertoires où sont enfin stockés les fichiers Excel

2 - Lui demander d'appliquer la macro de rupture de liens qui sera stockée dans mon fichier "personnal" de macros (je garde le nom déjà écrit dans le code).

Je pense que le mieux et que les 2 macros soient contenus dans le même module qui sera incorporé dans un fichier XLSM. (comme cela c'est plus simple à gérer).

Pouvez-vous m'aider ?!

Merci à tous !