Discussion :

[florent77]

Salut à toutes à tous,

Je rencontre un petit problème.
J'essaie de copier un dossier et son contenu à l'aide de CopyFolder.
J'aimerais que le dossier de destination ait le même nom que le fichier excel sur lequel je lance ma macro.
Il crée bien le dossier mais ensuite : "Chemin d'accès introuvable"
Si quelqu'un a une idée ??
Merci à vous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Copier_Dossier()
 
Dim nom_dossier As String
Dim GestionFichier As New Scripting.FileSystemObject
 
 
nom_dossier = ThisWorkbook.Name
nom_dossier = Left(nom_dossier, InStrRev(nom_dossier, ".") - 1)
 
GestionFichier.CopyFolder "C:\Users\moi\Desktop\toto", "C:\Users\moi\Desktop\ " & nom_dossier & "  "
Set GestionFichier = Nothing
 
 
End Sub

[sogedic]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

GestionFichier.CopyFolder "C:\Users\cClo\Downloads\cc", "C:\Users\cClo\Downloads\" & nom_dossier & "  "

il faut que le repertoire source existe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\moi\Desktop\toto"

et que la racine du repertoire destination existe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\moi\Desktop\ "

. seul le sousrepertoire - ici mondossier - est crée s'il n'existe pas
Peut-être un espace de trop

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\moi\Desktop\toto", "C:\Users\moi\Desktop\" & nom_dossier

[Menhir]

CopyFolder ne permet pas de changer le nom du dossier copié.
Le paramètre dossier destination est uniquement le réceptacle du dossier copié et doit donc exister.
https://docs.microsoft.com/fr-fr/off...yfolder-method

Si tu veux que le dossier destination ait un nom différent, il faut, dans un deuxième temps, le renommer.
Au choix :
https://docs.microsoft.com/fr-fr/off...mobject-object
https://docs.microsoft.com/fr-fr/off...name-statement

Pour faire ça en une seule instruction : https://docs.microsoft.com/fr-fr/off...copy-statement

[florent77]

Bonjour le forum,


Merci à sogedic et Mehnir !

@ sogedic : c'était bien cela, merci beaucoup

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\moi\Desktop\" & nom_dossier

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\moi\Desktop\ " & nom_dossier & " "

@ Menhir : merci pour la doc, par contre le code fonctionne bien avec CopyFolder sans avoir recours à FileCopy (ou alors je n'ai pas compris tes remarques)

=> les fichiers sont transférés du dossier "toto" vers le dossier nouvellement créé et renommé.

à essayer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Copier_Dossier()
 
Dim nom_dossier As String
Dim GestionFichier As New Scripting.FileSystemObject
 
nom_dossier = ThisWorkbook.Name
nom_dossier = Left(nom_dossier, InStrRev(nom_dossier, ".") - 1)
 
GestionFichier.CopyFolder "C:\Users\moi\Desktop\toto", "C:\Users\moi\Desktop\" & nom_dossier 
Set GestionFichier = Nothing
 
End Sub

[patricktoulon]

re
oui menhir c'est mal exprimé
ce qu'il a voulu dire c'est que l'on peut pa renomer le dossier cible avec copyfolder mais c'est la copie qui porte un autre nom

comme je n'ai pas bien compris

voici un exemple avec commentaire
je copi le dossier dans un dossier créé a la meme racine et la copie porte un autre nom

de "C:\Users\polux\Desktop\toto" j'arrive à "C:\Users\polux\Desktop\mondossier\barbeapapa"

le dossier barbeapapa c'est le dossier toto a l'origine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Dim OFSO, chemincomplet$, chemin$, Oldname$, new_name$, nouveau_Parent$
    'creation de l'object spriptingfilesystemobject
    Set OFSO = CreateObject("Scripting.FileSystemObject")
    'chemin complet du d'ossier ciblé
    chemincomplet = "C:\Users\polux\Desktop\toto"    'chemin complet du dossier
    'recuperation du chemin parent du dossier ciblé
    chemin = Mid(chemincomplet, 1, InStrRev(chemincomplet, "\"))
    'facultatif juste pour la demo recupe du nom du dossier ciblé
    Oldname = Replace(chemincomplet, chemin, "")    ' nom du dossier
    new_name = "barbeapapa"
    ' creation du nouveau dossier parent du dossier
    nouveau_Parent = chemin & "mondossier"    'chemin du dossier parent de destination
    'test d 'existence et creation si il n'existe pas
    If Dir(nouveau_Parent, vbDirectory) = "" Then MkDir nouveau_Parent    ' creation du nouveau dossier parent
    'et enfin copy du dossier ciblé dans la nouvelle destination
    OFSO.CopyFolder chemincomplet, nouveau_Parent & "\" & new_name, True    'copie du dossier dans son nouveau parent
End Sub

[patricktoulon]

pour le coup je t'ai fait une petite fonction qui fait tout

elle te copie sous un autre nom au meme endroit ou ailleurs les parametres sont optionals
si l'arboresecence du dossier de destination n'existe pas elle est créée etage par etage

la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function copy_folder_to(ByVal dossier, Optional ByVal new_parent$, Optional ByVal new_name$)
    Dim OFSO, chemin$, Oldname$, etage, i&
    'creation de l'object spriptingfilesystemobject
    Set OFSO = CreateObject("Scripting.FileSystemObject")
    If new_parent = "" And new_name = "" Or new_name = "" Then new_name = Mid(dossier, InStrRev(dossier, "\") + 1) & "(Copie)"
    If new_parent = "" Then new_parent = Mid(dossier, 1, InStrRev(dossier, "\"))    'recuperation du chemin parent du dossier ciblé
 
    'test d 'existence et creation si le new_parent  n'existe pas
    If Dir(new_parent, vbDirectory) = "" Then
        etage = Split(new_parent, "\")
        chemin = etage(0)
        For i = 1 To UBound(etage)
            chemin = chemin & "\" & etage(i)
 
            ' creation de l'etage(i) de l'arboresence du nouveau dossier parent si elle n'existe pas
            'If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'methode VBA
            If Dir(chemin, vbDirectory) = "" Then OFSO.CreateFolder (chemin)    ' methode FSO
        Next
    End If
    OFSO.CopyFolder dossier, new_parent & "\" & new_name, True    'copie du dossier dans son nouveau parent
End Function

et divers test en demo

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test2()
    dossier$ = "C:\Users\polux\Desktop\toto"
    new_parent$ = "C:\Users\polux\Desktop\truc\machin\chouette"
    '-------------------------------------------------------------------------------
    'EXEMPLE 1:
    'copie du dossier au meme endroit avec le sufixe "(copie) automatique
    copy_folder_to dossier
    '-------------------------------------------------------------------------------
    'EXEMPLE 2:
    'copie du dossier au meme endroit sous le nom en parametre
    ' copy_folder_to dossier, new_name:="barbeapapa"
    '-------------------------------------------------------------------------------
    'EXEMPLE 3:
    'copie du dossier dans un autre parent sous le nom de "bidule"
    'new_parent$ = "C:\Users\polux\Desktop\truc\machin\chouette"
    'copy_folder_to dossier, new_parent$, "bidule"
    '-------------------------------------------------------------------------------
    'EXEMPLE 4
    'copie du dossier dans un autre parent sous son  nom  avec le sufixe "(copie)" automatique
    'si l'arborescence du new_parent n'existe pas elle sera créée!!!!
    'new_parent$ = "C:\Users\polux\Desktop\truc\machin\chouette"
    copy_folder_to dossier, new_parent$
End Sub

c'est sans doute a parfaire je suis tout ouie je vais sans doute la garder