ouverture de sous repertoire

Une façon de faire - > Répertoire et sous-répertoire (1 er niveau)

Tu complètes la déclaration des variables ...la liste
n'est pas exhaustive...

Sub test1()

Dim Fs As Object, Files As Object, F As Object
Dim NomDossier As String, Dossier As Object
Dim Sf As Object, Fx As Object
Set Fs = CreateObject("Scripting.FileSystemObject")

NomDossier = "c:Atravail" ' choix du répertoire

'On Error Resume Next
If NomDossier = "" Then Exit Sub
Set Dossier = Fs.GetFolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
Set F = Fs.GetFolder(NomDossier)
Set Sf = F.SubFolders
'Pour chaque répertoire de la collection répertoires
For Each Fx In Sf
'Pour chaque fichier du répertoire
For Each fo In Fx.Files
'Check si c'est un fichier excel
If UCase(Right(fo.Name, 4)) = ".XLS" Then
'Nom du fichier
y = fo.Name
'nom du répertoire
z = Fx.Name
'nom du chemin complet et le nom du fichier
P = F.Name & "" & z & "" & y
'Ajoute le code pour traiter chacun de tes fichiers.
End If
Next fo
Next
End If

End Sub





"yan" <xyz@wanadoo.fr> a écrit dans le message de news: 456b2b76$0$25943$ba4acef3@news.orange.fr...
Bonjour à tous
J'ai un répertoire principal "2007"
Dans ce répertoire des sous-répertoires,(aujourd'hui 20 demain?)
Dans chaque sous-répertoires des fichiers dont un fichier Excel nommé
"suivi.xls" (donc 20 fichiers "suivi")
chaque fichiers "suivi" a la même structure même colonne même champs, mais
nombres de lignes variable
Dans le fichier principal il y a un autre répertoire qui contient un fichier
Excel "recap"
L'objectif
1)ouvrir le fichier "recap" manuellement
2)lancer une macro qui ouvrira un à un les 20 sous-répertoires et récupérer
une donnée (ou plus a voir) dans chaque fichiers (la donnée sera soit
toujours au même endroit ou dans une cellule ayant toujours le même nom)
3)copier les données dans "recap"
Ma question porte sur l'ouverture des sous-répertoires
Y aurait t-il un code du genre

pour chaque sou-rep de 2007
ouvrir le fichier suivi.xls
récupérer la donnée et la copier dans "recap"(là je devrait savoir faire)
fermer le sous rép
sous rep suivant
J'espère avoir été clair (pas sur)
Merci à qui peut m'aider
A+
Yan

Merci
J'étudie cela demain au boulot et je te dit
Bonne soirée
Yan

Cette présentation est plus simple et complète :


Sub test1()

Dim Fs As Object, Files As Object, F As Object
Dim NomDossier As String, Dossier As Object
Dim Sf As Object, Fx As Object
Set Fs = CreateObject("Scripting.FileSystemObject")

NomDossier = "c:Atravail" ' choix du répertoire

'On Error Resume Next
If NomDossier = "" Then Exit Sub
Set Dossier = Fs.GetFolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each ff In Files
If UCase(Right(ff.Name, 4)) = ".XLS" Then
'Traitement des fichiers situés au premier niveau
Traitement ff
End If
Next
Set F = Fs.GetFolder(NomDossier)
Set Sf = F.SubFolders
'Pour chaque répertoire de la collection répertoires
For Each Fx In Sf
'Pour chaque fichier du répertoire
For Each Fo In Fx.Files
'Check si c'est un fichier excel
If UCase(Right(Fo.Name, 4)) = ".XLS" Then
'Traitement des fichiers situés au deuxième niveau
Traitement F.Name & "" & Fx.Name & "" & Fo.Name
End If
Next Fo
Next
End If

End Sub

Sub Traitement(Fichier)
'C'est ici que tu définis le traitement pour chacun
'des fichiers
MsgBox Fichier
End Sub




"yan" <xyz@wanadoo.fr> a écrit dans le message de news: 456b3673$0$5095$ba4acef3@news.orange.fr...
Merci
J'étudie cela demain au boulot et je te dit
Bonne soirée
Yan

Bonjour
Et bien c'est impect!
J'ai essayé cette aprem et c'est exactement ce qu'il fallait.
Plus qu'a fignoler la partie récupération des données, mais là je sais
faire.
Je te remercie vivement, et je suis toujours admiratif pour un certain
d'entres vous qui etes des "pointures" dans ce domaine.
Surtout la rapidité avec laquelle tu as solutionné ma demande.
Il y a bien sur des choses que je ne comprends pas car ça dépasse mes
compétences actuelles
par exemple
Set Fs = CreateObject("Scripting.FileSystemObject")
Fs.GetFolder(NomDossier)
Mais l'essentiel c'est que ça tourne
Encore merci
A+
Yan

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eJWUJflEHHA.4832@TK2MSFTNGP06.phx.gbl...

Cette présentation est plus simple et complète :


Sub test1()

Dim Fs As Object, Files As Object, F As Object
Dim NomDossier As String, Dossier As Object
Dim Sf As Object, Fx As Object
Set Fs = CreateObject("Scripting.FileSystemObject")

NomDossier = "c:Atravail" ' choix du répertoire

'On Error Resume Next
If NomDossier = "" Then Exit Sub
Set Dossier = Fs.GetFolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each ff In Files
If UCase(Right(ff.Name, 4)) = ".XLS" Then
'Traitement des fichiers situés au premier niveau
Traitement ff
End If
Next
Set F = Fs.GetFolder(NomDossier)
Set Sf = F.SubFolders
'Pour chaque répertoire de la collection répertoires
For Each Fx In Sf
'Pour chaque fichier du répertoire
For Each Fo In Fx.Files
'Check si c'est un fichier excel
If UCase(Right(Fo.Name, 4)) = ".XLS" Then
'Traitement des fichiers situés au deuxième niveau
Traitement F.Name & "" & Fx.Name & "" & Fo.Name
End If
Next Fo
Next
End If

End Sub

Sub Traitement(Fichier)
'C'est ici que tu définis le traitement pour chacun
'des fichiers
MsgBox Fichier
End Sub




"yan" <xyz@wanadoo.fr> a écrit dans le message de news:
456b3673$0$5095$ba4acef3@news.orange.fr...
Merci
J'étudie cela demain au boulot et je te dit
Bonne soirée
Yan