XL 2021 Déplacement de répertoires N-1 vers autre dossier

[Lionel69890]

Bonjour à tous,

Quelqu'un peut-il m'aider à créer une macro qui déplace tous les sous répertoires, des répertoires contenu sous D:\TEMP\ vers D:\NEW\

Merci d'avance de votre aide

 

[vgendron]

Bonjour

avec un peu de lecture ici, tu devrais surement trouver ton bonheur

Manipulation des fichiers en VBA

Manipulation des fichiers en VBA

warin.developpez.com

 

[Lionel69890]

Merci de ton retour, j'ai essayé ce code mais il bloque sur la ligne indiquée en noire

Sub DeplacerSousRepertoires()

Dim SourceRootPath As String
Dim DestinationRootPath As String
Dim FSO As Object
Dim SourceRootFolder As Object
Dim SubRootFolder As Object
Dim SubSubFolder As Object

SourceRootPath = "D:\TEMP\"
DestinationRootPath = "D:\NEW\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceRootFolder = FSO.GetFolder(SourceRootPath)

' Parcourt tous les sous-répertoires dans le dossier source
For Each SubRootFolder In SourceRootFolder.SubFolders
' Parcourt tous les sous-répertoires dans chaque sous-répertoire
For Each SubSubFolder In SubRootFolder.SubFolders
' Déplace le sous-répertoire vers la destination
FSO.MoveFolder SubSubFolder.Path, DestinationRootPath & SubSubFolder.Name
Next SubSubFolder
Next SubRootFolder

Set SourceRootFolder = Nothing
Set FSO = Nothing
MsgBox "Déplacement des sous-répertoires terminé !"
End Sub

 

[vgendron]

es tu sur que les répertoires Source ET destination existent vraiment
j'ai cru voir quelque part que les dossiers devaient etre créés avant..

 

[Lionel69890]

oui oui ils sont bien créés ...

 

[vgendron]

je viens de faire le test chez moi..
pas de souci...
il faut AUSSI que les fichiers qui vont etre déplacés soient tous fermés..

 

[Lionel69890]

Ok après vérification il y avait bien un fichier ouvert.
Mon code fonctionne bien 🙂