VBA: copier un dossier et son contenu 1

La méthode .CopyFolder

En gros, nous allons créer un nouvel Objet FSO (FileSystemObject) qui nous permettra d'utiliser la méthode .CopyFolder pour copier un dossier.

Voici donc les 3 lignes de code VBA dont vous aurez besoin. Ce n'est vraiment pas compliqué.

Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFolder "C:\test\DossierOriginal", "C:\test2\SousDossier\CopieDuDossierOriginal", True

Comme indiqué plus haut, ce code va copier le dossier avec tout son contenu (sous-dossiers et fichiers). Si le dossier que vous voulez copier n'existe pas, la macro va bloquer avec un message d'erreur. C'est pourquoi je vous conseille de d'abord vérifier si le dossier existe.

Vous pouvez également vérifier si le nouveau dossier n'existe pas déjà. Car s'il existe déjà, vous risquez de sur-écrire des fichiers existants.

Attention, les deux dossiers ne peuvent pas se terminer par la barre oblique ("/") ou la barre oblique inverse ("\"). Si c'est le cas, le code va bloquer et générer une erreur.

Code VBA en tant que fonction pour copier un dossier

Il est bien sûr possible de faire de ce code une fonction indépendante qui aura pour arguments le chemin du dossier à copier ainsi que le chemin du nouveau dossier…

Cette fonction retourne comme résultat un Boolean (VRAI / FAUX – TRUE / FALSE): TRUE si le dossier a pu être copié, FALSE si une erreur s'est produite quelque part.

Elle contient quelques améliorations:

• une vérification est faite au cas où un (les) argument(s) serait vide
• elle vérifie si le dossier qui doit être copié existe
• elle vérifie si les chemins ne contiennent pas les barres obliques à la fin, si oui, une correction est faite automatiquement

On obtient ainsi une fonction robuste qui ne plantera pas votre macro même en cas de problème…

Et voici déjà le code:

Public Function CopieDossier(DossierOriginal As String, DossierCopie As String)
'par Excel-Malin.com ( https://excel-malin.com )
    CopieDossier = False

'vérifie si les arguments ne sont pas vides
If DossierOriginal = "" Or DossierCopie = "" Then Exit Function


'vérifie s'il n'y a pas des (back)slash à la fin des deux chemins
If Right(DossierOriginal, 1) = "\" Or Right(DossierOriginal, 1) = "/" Then DossierOriginal = Left(DossierOriginal, Len(DossierOriginal) - 1)
If Right(DossierCopie, 1) = "\" Or Right(DossierCopie, 1) = "/" Then DossierCopie = Left(DossierCopie, Len(DossierCopie) - 1)

'teste si le Dossier original existe, si oui, copie le dossier et retourne valeur True, si non, retourne valeur False
If Len(Dir(DossierOriginal, vbDirectory)) = 0 Then
    Exit Function
Else
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.CopyFolder DossierOriginal, DossierCopie, True
    CopieDossier = True
End If

End Function

Conclusion

Une fonction relativement simple mais qui peut tout de même vous économiser le temps et permettre d'ajouter nouvelles fonctionnalités à vos applications en VBA et en Excel. Vous pouvez l'utiliser par exemple pour l'archivage régulier des données ou encore pour une migration des données d'un endroit à l'autre…

Vous pouvez aussi consulter la Page Microsoft dédiée à la méthode .CopyFolder. Attention, il s'agit d'une traduction automatique (anglais >> français)…