fichiers et repertoire

Le
STEPH B
Bonjour

Je dispose d un répertoire sous un lecteur "s:"

donc "s:dossier"

sous ce répertoire il y a 3 repertoire
BAT A
BAT B
BAT C
ce qui donne
"s:dossierBAT A"
"s:dossierBAT B"
"s:dossierBAT C"

sous chaucun de ces 3 repertoires il y a une multitude de répertoires

sous chacun de ces sous répertoires il y a a chaque fois un fichier nommé
"*ARCHIVE*.pdf"

je voudrais que excel me créé un répertoire sous "d:" par exemple
et me créé "d:BAT A" avec dessous tous les fichiers "*ARCHIVE*.pdf" trouvé
sous "s:dossierBAT A" et ainsi de suite pour B et C.

merci d 'avance
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
DanielCo
Le #22963401
Bonjour.
Essaie d'exécuter la macro test suivante (non testée) d'après une macro
de JB :

Sub test()
Dim Chemins
Const Chemin = "s:dossierBAT "
Chemins = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Item In Chemins
rep = Chemin & Item
repcible = "d:BAT " & Item
MkDir repcible
Set dossier_racine = fso.getfolder(rep)
Set dossier_racine = fso.getfolder("d:donneesdaniel")
Lit_dossier1 dossier_racine, repcible
Next Item
End Sub
Sub Lit_dossier1(ByRef dossier, repcible)
For Each f In dossier.Files
If IsNumeric(Application.Find("*ARCHIVE*.pdf", f.Name)) Then
FileCopy f.Path, repcible & "" & f.Name
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d, r
Next
End Sub

Cordialement.
Daniel
DanielCo
Le #22963391
Oups.

Sub test()
Dim Chemins, Rep As String, RepCible As String
Const Chemin = "s:dossierBAT "
Chemins = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Item In Chemins
Rep = Chemin & Item
RepCible = "d:BAT " & Item
MkDir RepCible
Set dossier_racine = fso.getfolder(Rep)
Lit_dossier1 dossier_racine, RepCible
Next Item
End Sub
Sub Lit_dossier1(ByRef dossier, RepCible)
For Each f In dossier.Files
If IsNumeric(Application.Find("*ARCHIVE*.pdf", f.Name)) Then
FileCopy f.Path, RepCible & "" & f.Name
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d, r
Next
End Sub

Daniel
STEPH B
Le #22964011
merci pour ton code ca a l air d etre dans le mouvement de ce que je
souhaite il créé bien les repertoire BAT A B C
mais sur mon repertoire source les fichiers ARCHIVE*.pdf sont sous des sous
sous répertoires
et ce le code ne le calcul pas.




"DanielCo" ifckft$4j4$
Oups.

Sub test()
Dim Chemins, Rep As String, RepCible As String
Const Chemin = "s:dossierBAT "
Chemins = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Item In Chemins
Rep = Chemin & Item
RepCible = "d:BAT " & Item
MkDir RepCible
Set dossier_racine = fso.getfolder(Rep)
Lit_dossier1 dossier_racine, RepCible
Next Item
End Sub
Sub Lit_dossier1(ByRef dossier, RepCible)
For Each f In dossier.Files
If IsNumeric(Application.Find("*ARCHIVE*.pdf", f.Name)) Then
FileCopy f.Path, RepCible & "" & f.Name
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d, r
Next
End Sub

Daniel


DanielCo
Le #22964111
Ca devrait être mieux :

Sub test()
Dim Chemins, Rep As String, RepCible As String
'Const Chemin = "s:dossierBAT "
Const Chemin = "d:donneesdanielmpfetempDossierBAT "
Chemins = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Item In Chemins
Rep = Chemin & Item
RepCible = "d:BAT " & Item
MkDir RepCible
Set dossier_racine = fso.getfolder(Rep)
Lit_dossier1 dossier_racine, RepCible
Next Item
End Sub
Sub Lit_dossier1(ByRef dossier, RepCible)
For Each f In dossier.Files
If IsNumeric(Application.Find("ARCHIVE", f.Name)) And _
Right(f.Name, 4) = ".pdf" Then
FileCopy f.Path, RepCible & "" & f.Name
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d, RepCible
Next
End Sub

Daniel
DanielCo
Le #22964101
... en reprenant TES noms de dossier :

Sub test()
Dim Chemins, Rep As String, RepCible As String
Const Chemin = "s:dossierBAT "
Chemins = Array("A", "B", "C")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Item In Chemins
Rep = Chemin & Item
RepCible = "d:BAT " & Item
MkDir RepCible
Set dossier_racine = fso.getfolder(Rep)
Lit_dossier1 dossier_racine, RepCible
Next Item
End Sub
Sub Lit_dossier1(ByRef dossier, RepCible)
For Each f In dossier.Files
If IsNumeric(Application.Find("ARCHIVE", f.Name)) And _
Right(f.Name, 4) = ".pdf" Then
FileCopy f.Path, RepCible & "" & f.Name
End If
Next f
For Each d In dossier.SubFolders
Lit_dossier1 d, RepCible
Next
End Sub

Daniel
Publicité
Poster une réponse
Anonyme