macro fonctionnant dans les sous-répertoire

[flosauveur69]

Bonjour à tous,

J'ai une macro qui fonctionne quand je met le classeur mère dans le dossier où se trouve les classeurs fils.

Cependant, j'aimerais que le classeur mère se trouvent à l'extérieur du dossier où se trouvent les classeurs fils. Jusque là ça va mais les classeurs fils sont en fait dans des sous répertoire du dossier.

Dans la macro ci-dessous, j'ai donc remplacé cette ligne

strFile = Dir(ThisWorkbook.Path & "\*.xls")

par

strFile = Dir("D:\Documents and Settings\fl\Bureau\excel" & "\SousRepertoire\*.xls")

cependant cela ne fonctionne pas

Private Sub cmdRecupere_Click()
Dim intFile As Integer
Dim strWB As String
Dim strFile As String
Dim lgDerLig As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

' Nom du classeur actuel
strWB = ThisWorkbook.Name

lgDerLig = 2

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Feuil1").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
Workbooks(strWB).Worksheets("Feuil1").Range("C" & lgDerLig) = strFile
lgDerLig = lgDerLig + 16 'il me semble, puique la hauteur copiée est de 16...

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub



MERCI de votre aide

 

[flosauveur69]

Re : macro fonctionnant dans les sous-répertoire

Bonjour Flosauveur69

Le code ne traite pas la redondance des sous-répertoires,
effectue une recherche sur le forum à ce sujet

A+

Tu veux dire que c`est impossible? (ca me parait bizarre)
Je déterre ce topic car comme explique plus haut j`ai fait des recherches, essayé des bouts de code mais rien ne fonctionne. C`est pourquoi je redemande de l`aide. Merci

 

[Compte Supprimé 979]

Re : macro fonctionnant dans les sous-répertoire

Re,

Tu veux dire que c`est impossible? (ca me parait bizarre)​

Ce n'est absolument pas ce que j'ai dis, je vais être plus explicite ....
Le code en l'état en traite pas la redondance des sous-dossiers

Un exemple de sujet trouvé
https://www.excel-downloads.com/thr...-dossier-contenu-dans-un-dossier-mere.156890/

A+

 

[flosauveur69]

Re : macro fonctionnant dans les sous-répertoire

Re,


Ce n'est absolument pas ce que j'ai dis, je vais être plus explicite ....
Le code en l'état en traite pas la redondance des sous-dossiers

Un exemple de sujet trouvé
https://www.excel-downloads.com/thr...-dossier-contenu-dans-un-dossier-mere.156890/

A+

Merci je vois que c`est donc possible et il faut donc que j`adapte mon code, le problème c`est que je ne suis pas un crack en VBA du coup il me faudrait un peu d`aide ou quelques pistes si possible

 

[flosauveur69]

Re : macro fonctionnant dans les sous-répertoire

Bonjour a tous, finalement j`ai trouvé un moyen plus simple, au lieu de sélectionner tous les sous répertoire du répertoire, je voudrais seulement sélectionner les répertoires suivants :
D:\testlist\CMV01
D:\testlist\CMV42

Et 2eme contrainte si c`est possible, sélectionner les fichiers seulement compris entre 2 dates (les dates pourront être contenu dans des cellules du classeur feuil1 A1 et B1)

Apres cela cette macro devrait être nikel, merci à vous

 

[flosauveur69]

Re : macro fonctionnant dans les sous-répertoire

Pourriez-vous m`aider car je modifie le Strfile et le chemin mais la macro ne fonctionne plus ensuite, voici la macro a modifier:


Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String



Application.ScreenUpdating = False
Application.EnableEvents = False


' Nom du classeur actuel
strWB = ThisWorkbook.Name

' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir ThisWorkbook.Path & "\*.html")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("Calcul2").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

Chemin = ThisWorkbook.Path & "\" & strFile
Set Objet = CreateObject("Scripting.FileSystemObject")
Set Fichier = Objet.GetFile(Chemin)

' Copie des données
Workbooks(strFile).Worksheets(1).Range("A11:C28").Copy
With Workbooks(strWB).Worksheets("Calcul2")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("c2:c19").ClearContents 'on ne garde que les données A2:B17
.Range("C3") = strFile
.Range("c2") = Fichier.DateLastModified


End With

' Fermeture du classeur
Workbooks(strFile).Close
End If

' Classeur suivant
strFile = Dir
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub

 

[flosauveur69]

Re : macro fonctionnant dans les sous-répertoire

J`ai finalement trouve solution à mon problème en dupliquant une partie de ma macro