Microsoft 365 Ecrire dans une cellule de tous les fichiers des sous-dossiers avec choix du dossier de base

[warmich]

Bonjour à tous

J'ai cherché mais j'ai pas trouvé...

J'aimerais écrire dans une cellule (A1) de tous les fichiers xlsx contenus dans des sous-dossiers avec choix du dossier de base.

J'ai donc entre 5 et 10 fichiers FT******.xlsx dans une centaine de sous-dossiers dont certains sont dans des sous-sous-dossiers (5 niveaux maximums)

Je voudrais écrire un texte par exemple "Bonjour" dans chaque cellule A1 de chaque fichier xlsx de chaque dossier...

Merci à Toi expert ;-)

Voici mon code de base :

Function ChoixDossier()
On Error Resume Next
    With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = ActiveWorkbook.Path & "\"
      .Show
      If .SelectedItems.Count > 0 Then
         ChoixDossier = .SelectedItems(1)
      Else
         ChoixDossier = ""
      End If
    End With
End Function

Sub EcrireBonjour()
Dim wbk As Workbook
Dim rep, nf As String
  rep = ChoixDossier & "\"
  nf = Dir(rep & "*.xlsx")
  Application.ScreenUpdating = False
   Do While Len(nf) > 0
   Set wbk = Workbooks.Open(rep & nf)
  With wbk
    .Sheets(1).Range("A1").Formula = "Bonjour"
    .Close True
   End With
  nf = Dir()
  Loop
End Sub

 

[patricktoulon]

bonjour
il te faut un parcours récursif avec dir ou autre
tu trouvera dans ce forum moult exemple de liste récursive des dossiers sous dossiers