sous ce répertoire il y a 3 repertoire
BAT A
BAT B
BAT C
ce qui donne
"s:\dossier\BAT A"
"s:\dossier\BAT B"
"s:\dossier\BAT 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:\dossier\BAT A" et ainsi de suite pour B et C.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
DanielCo
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
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
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
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
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
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
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" a écrit dans le message de news: 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
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" <dcolardelleZZZ@free.fr> a écrit dans le message de news:
ifckft$4j4$1@speranza.aioe.org...
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
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" a écrit dans le message de news: 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
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
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
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
... 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
... 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
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
