XL 2010 Comment copier tous les fichiers d'un répertoire et de ses sous-répertoires vers un dossier unique ?

[pcone75]

Bonjour
Je travaille sous Excel 2010 sous Windows 2010 Entreprise
Je cherche une macro vba qui me permettrait d'extraire (copier), tous les fichiers d'un répertoire et de ses sous-répertoires, vers un répertoire unique (nommé par exemple : extract).
Je pense que ceci doit être très facile pour certains mais je débute en vba et je ne sais que copier du code existant et le modifier, selon mes modestes connaissances.

Je ne veux pas une macro qui liste les répertoires et sous-répertoires et leur contenu (ça je connais mais ça ne m'est pas utile dans le cas présent) mais bien copier l'intégralité des fichiers trouvés dans l'ensemble du répertoire te ses sous-répertoires vers un autre dossier.

Pour plus de détails, j'ai un répertoire COMPIL, composé de sous-répertoires (A, B, C, D...) qui contiennent chacun un ou plusieurs fichiers (voire sous-répertoires et fichiers également). Je voudrais par une manip simple (une macro vba), copier tous les fichiers du répertoire COPIL et de l'ensemble des sous-répertoires (A, B, C, D...) et également de leurs propres sous-répertoires, vers un répertoire unique nommé "extract" pour pouvoir ensuite les ouvrir et travailler dessus sans être obligé de scruter l'ensemble des répertoires de COMPIL à la main.

Merci par avance pour votre aide
Cordialement
Pascal

 

[jzouille]

re
de toute façon sauf j'en perds mon français c'est pas ce que tu a demandé
donc le fso.copyfolder est hors sujet
il te faut dans tout les cas avec fso ou dir une fonction récursive ou a 2 boucle imbriquée avec rebond

Ouah pour moi ça devient chinois.
Si qqun pouvait m'écrire directement le code ce serait cool

 

[cp4]

Ca ne marche pas. Le code me mets erreur

@jzouille : il y avait une proposition du chemin en dur dans le code et tu voulais que le chemin soit mis dans une cellule. Il faut adapter le chemin dans le fichier joint car chez moi ça fonctionne. Le code copie tous les sous-répertoires ainsi que les fichiers dans le dossier de destination. A moins que tu ne veuilles copier seulement les fichiers de toute l'arborescence dans le dossier de destination. Si c'est le cas, PatrickToulon t'a indiqué une piste.

/!\ Pourquoi n'as-tu pas ouvert ta propre discussion comme te l'a signalé @Staple1600 .

Joint ton fichier.

Bonne soirée à toutes et à tous.

 

[patricktoulon]

j'ai pas envie ce soir de vous expliquer comment faire un dir récursif qui de natif ne l'est pas (demain je vous montrerais)
en attendant voici une version harcahique avec fso (je l'ai pris dans un de mes vieux fichier xls 2003)

cp4 je te laisse le soins d'adapter cela a la demande

Sub test()
    Dim racine$
    racine = "F:\windows seven"
    tableau = recherche_récursive(racine)
    Cells(1, 1).Resize(UBound(tableau) + 1, 1) = Application.Transpose(tableau)
End Sub
'
'
Private Function recherche_récursive(dparent, Optional L As String) As Variant
    Dim FSO As Object, Lparent As Object, SubFolder As Object, Ficher
    Set FSO = CreateObject("scripting.filesystemobject")    ' on declare l'object
    ' regard sur les fichiers
    Set Lparent = FSO.GetFolder(dparent)    'on attribue a l'object.getfolder le dossier demandé 'Scripting.Folder
    'MsgBox GetAttr(Lparent)
    If GetAttr(Lparent) <> 22 Then
        For Each Ficher In Lparent.Files    'on boucle sur les fichiers qui sont dans ce dossier
            L = L & Ficher & vbCrLf
        '!!!!!!!!!!!!!c'est ici qu'il faut faire la copie!!!!!!!!!!!!!
        Next

        'boucles sur les sous dossiers
        For Each SubFolder In Lparent.SubFolders    'on boucle sur les dossiers qui sont dans ce dossiers
            L = L & SubFolder.Path & vbCrLf
            recherche_récursive SubFolder.Path, L   ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que l'extension et L qui est déjà peut être remplie
        Next SubFolder
    End If

    recherche_récursive = Split(L, vbCrLf)    'on coupe la liste par les saut de lignes on a maintenant un array la fonction devient cet array
End Function

 

[Staple1600]

=>Patricktoulon

A quoi cela sert-il que l'on soit deux "répondeurs" cp4 et moi-même à conseiller à jzouille d'ouvrir sa propre discussion si un 3ième "répondeur" continue de répondre dans ce fil de 2019 initié par un autre membre?
Où est la cohérence?
Où est le travail en commun?
Où est la télécommande?
Où sont les femmes?

Je ne peux que me désolidariser de cette attitude et cela m'oblige à te rendre l'enveloppe pour tu sais quoi!

 

[patricktoulon]

you talking to me!!!! tou sè ki jy suit!!!!!

 

[Staple1600]

Re

Kitué?
Oui je sais
1) Quelqu'un qui a du mal avec la synergie entre membres
2) Quelqu'un qui a oublié la puissance de PowerShell

 

[patricktoulon]

re
perso je fait du vba donc powershell .....
sinon je serais sur un forum powershell
a question vba je répond vba je répondrais powershell ou vbs ou même dos uniquement si ca n'est pas possible autrement

 

[Staple1600]

Re

perso pile poil ce qui va bien avec synergie...
Euh Excel est d'abord un tableur
Alors quand on demande à Excel de faire des choses qui ne sont pas "son cœur de métier" on peut conseiller au demandeur d'utiliser les outils idoines, non ? (tel que PowerShell)
C'est indolore et ca ne mange pas de pain.
Pour le reste, rien n'empêchait d'attendre que jzouille ouvre sa discussion pour y poster ton dernier code qui n'a rien de VBA puisqu'il fait à appel à du CreateObject.