Autres Copie de répertoire (mais avec son icone)

[Michou9]

Bonjour à tous
J'utilise une macro pour copier des dossiers
Mais bizarrement lors de cette copie je perds son icone
Je ne comprends pas d'où cela peut venir
Et je viens chercher de l'aide sur le Forum
J'utilise Excel 2007

Sub CopieDossier()
Dim fs As Object, copie As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set copie = fs.GetFolder _
("C:\M\MonDossier")
copie.Copy "F:\Repertoire\A\1\"
End Sub

 

[job75]

Bonjour Michou9,

Je n'ai pas de lecteur F alors j'ai enregistré le fichier de la macro sur le bureau et exécuté :

Sub CopieDossier()
Dim chemin$, fs As Object, copie As Object
chemin = ThisWorkbook.Path & "\A\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier
chemin = chemin & "1\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier
Set fs = CreateObject("Scripting.FileSystemObject")
Set copie = fs.GetFolder _
("C:\M\MonDossier")
copie.Copy chemin
End Sub

Le dossier ThisWorkbook.Path & "\A\1\MonDossier" est bien créé avec les fichiers qu'il contient.

Pour répondre à votre question s'il n'y a pas d'icône "MonDossier" c'est que la copie n'a pas eu lieu...

A+

 

[Michou9]

Bonjour Job75
Merci pour votre aide
Je viens de faire l'essai
Et je rencontre toujours le même problème

J'ai simplifier mon essai, j'ai tout mis sur C:

Voici votre code modifié pour cet essai :
Sub CopieDossierNew()
Dim chemin$, fs As Object, copie As Object
'chemin = ThisWorkbook.Path & "\F\"
chemin = "C:\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier
chemin = chemin & "5\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier
Set fs = CreateObject("Scripting.FileSystemObject")
Set copie = fs.GetFolder _
("C:\Base\Autre")
copie.Copy chemin
End Sub

Je joins une photo du résultat
A gauche les dossiers de base
A droite les dossiers ainsi copiés
Comme vous pouvez le voir, il n'ont plus d'icone

 

[job75]

Le dossier "C::\" n'a pas besoin d'être créé, il existe forcément toujours !

Vous copiez le dossier "C:\Base\Autres" et le collez dans "C:\5\"

Les icônes sont visibles à droite, que voulez-vous de plus ?

J'ai testé votre macro, elle fonctionne bien chez moi : le dossier "C:\5\Autres" a été créé.

 

[Michou9]

Non il n'y a pas d'icones à droites !
A gauche vous pouvez voir les 2 icones
Un icone gris avec un point d'interrogation pour le dossier essai
Un icone avec écran d'ordinateur pour le dossier autre
A droites ces même dossiers copiés n'ont pas ces icones

 

[job75]

J'avoue mon ignorance : chez moi sur Excel 2019 il n'y a qu'une seule sorte d'icône : un dossier jaune.

Sur toutes les versions que j'ai eues c'était comme ça mais je n'ai jamais eu Excel 2007.

 

[Michou9]

Les icones ne sont pas dues à Excel, mais à Windows
Certes je me sers d'Excel pour copier ces dossiers
Si je fais une copie de ces dossiers sous Windows, ces nouveaux dossiers copiés conservent bien les mêmes icones
Je voudrais obtenir le même résultat avec Excel

 

[Nain porte quoi]

Hello,

l'icône personnalisé d'un fichier se trouve dans le fichier desktop.ini qui est masqué par défaut. Afficher les fichier masqué et vous devriez pouvoir copier votre dossier avec son icône

 

[patricktoulon]

bonjour
c'est normal copyfolder et même celui de FSO n'enregistrent pas les attributs

@Nain_porte_quoi c'est pas tout a fait ca :ce que tu dit ca fonctionne uniquement si tu a decoché cette option dans les options de l'explorer

et donc comme la copie ne copie pas les propertie du dossier source il faut lui ajouté
quand tu met un icon avec propriété > personnaliser > changer d'icon
le sytem devient maitre du dossier (sans ça les icon perso ne s'affichent pas)
donc du coup il faut lui ajouter les attributs sytem pour que windoooos le reconnaisse comme tel
un petit exemple vite fait derrière les fagos comme ça

Sub CopierDossierAvecIcone()

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim Dossiersource As String
    Dim destination As String

    Dossiersource = "C:\Users\patricktoulon\Desktop\dossiertesticon"
    destination = "C:\Users\patricktoulon\Desktop\res\"
   fso.CopyFolder Dossiersource, destination, True
SetAttr destination & "dossiertesticon", vbSystem 'ajoute l'atribut system au dossier
SetAttr destination & "dossiertesticon\desktop.ini", vbHidden + vbSystem 'ajoute les propriété hidden et sytem au desktop.ini
    
    
End Sub

et voila

Patrick

 

[Michou9]

Hello,

l'icône personnalisé d'un fichier se trouve dans le fichier desktop.ini qui est masqué par défaut. Afficher les fichier masqué et vous devriez pouvoir copier votre dossier avec son icône

Bonjour Nain porte quoi
C'est vrai que je n'avais pas pensé à cela
J'ai donc désactivé les fichiers cachés, et j'ai même mis les extensions apparentes, même si cela n'a pas de rapport avec les dossiers
Malheureusement cela ne vient pas de là
D'ailleurs si on réfléchit bien, lorsque je copie ces dossiers sous Windows, les fichiers ini sont bien cachés
Merci quand même pour cette idée

 

[Michou9]

Bonjour Nain porte quoi
C'est vrai que je n'avais pas pensé à cela
J'ai donc désactivé les fichiers cachés, et j'ai même mis les extensions apparentes, même si cela n'a pas de rapport avec les dossiers
Malheureusement cela ne vient pas de là
D'ailleurs si on réfléchit bien, lorsque je copie ces dossiers sous Windows, les fichiers ini sont bien cachés
Merci quand même pour cette idéeur

Bonjour patricktoulon​

J'avais bien pensé aux attributs, mais je ne voyais pas vraiment le rapport avec les icones
Je viens de tenter d'utilisé votre code
Mais comme je ne le comprends pas bien
J'au du mal à le paramétrer avec mes liens éffectifs

 

[patricktoulon]

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

 

[patricktoulon]

allez kado
je sui parti sur l'exemple du post #1
j'ai ajouté ma magic fonction mkdir qui crée l'arborescence ou les manquant sans rien ecraser IN ONE SHOT
Je pense avoir suffisamment commenté
Si newname est vide il est tout simplement pas renommé

Sub CopieDossier()
    Dim fs As Object, source$, Destination$, newname$
    
    Set fs = CreateObject("Scripting.FileSystemObject") 'instanciation de l'object FSO (Scripting FileSystemObject) de la scrunn.dll
    
    source = "C:\Users\patricktoulon\Desktop\dossiertesticon" 'changer le dossier source ici
    
    newname = "toto" 'nouveau nom pour le dossier
    
    Destination = "F:\Repertoire\A\1\" ' chemin de destination
    
    MkDirMulti Destination 'appel de la fonction qui va créer tout l'arborescence ou les manquants (n'ecrase pas)
    
    fs.CopyFolder source, Destination & newname, True  'copie du dossier
    
    SetAttr Destination & newname, vbSystem 'ajoute l'atribut system au dossier
    
    SetAttr Destination & newname & "\desktop.ini", vbHidden + vbSystem 'ajoute les propriété hidden et sytem au desktop.ini
End Sub


'Fonction permettant de créer Toute l'arborescence ou tous les dossiers  manquants
'N'ecrase pas l'existant
'patricktoulon '
'version 2.0 avec CMD par le shell
Sub MkDirMulti(ArborescenceString As String)
     Shell "cmd /c mkdir """ & ArborescenceString & """", vbHide
End Sub

là si tu n'y arrive pas je ne peux plus rien pour toi 😉

Patrick

 

[Michou9]

Super !!!

Donc ce que disait Nain porte quoi avait bien du bon !
Je n’avais pas pensé aux fichiers system !
Autrefois sur les anciennes versions de Windows, tout étaient regroupés
Maintenant on a plus accès à cette option directement

Du coup tes 2 codes fonctionnent parfaitement
Juste une précision on ne peut laisser NewName vide
Il faut remettre le nom source si on veut garder le même nom

Du coup ce 2ème code m’arrange particulièrement car j’ai besoin aussi de le renommer
Cela je savais faire, mais là je n’ai plus besoin de l’intégrer dans le code, il y est déjà

Il me reste juste à ajouter un test pour vérifier si le dossier source existe bien

Je vous remercie tous les 3
Et surtout pour ton code, car je n’y serai pas arrivé

 

[TooFatBoy]

Hello,

l'icône personnalisé d'un fichier se trouve dans le fichier desktop.ini qui est masqué par défaut. Afficher les fichier masqué et vous devriez pouvoir copier votre dossier avec son icône

Are you sure ?
Si oui, alors il faut aussi copier le desktop.ini. N'est-il pas ?

[edit] Effectivement, pour un dossier, l'icône est "contenue" dans un fichier desktop.ini lui-même contenu dans ledit dossier. [/edit]

Je ne comprends pas d'où cela peut venir

As-tu essayé de faire la copie par "DOS" ?