Bonjour,
Après copie d'1 dossier avec sous-dossiers depuis ma boite Dropbox vers un serveur via une macro, je n'arrive pas via une autre macro à affecter les icônes.
Lors de la copie, il ne garde que le fichier icône *.ico et supprime le fichier desktop.ini
J'arrive a le créer, a entrer les valeurs dans ce même fichier pas cela ne fonctionne pas !
Je ne sais pas si c'est un problèmes de droits, d'encodage (UTF-8) ou autre, mais je cale.
J'ai besoin d'un petit coup de pouce

voici le code, je suis en Win 10 + excel 2016
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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
' MISE A JOUR DES ICONES D'UN DOSSIER ET DE CES SOUS-DOSSIERS
Sub maj_ico_dos(ByVal nom_clas_macro As Variant, ByVal nom_macro As Variant, ByVal nom_clas_actif As Variant, ByVal nom_fe As Variant, ByVal ch_dos As Variant, ByVal v6 As Variant, ByVal v7 As Variant, ByVal v8 As Variant, ByVal v9 As Variant, ByVal v10 As Variant)
  Stop
 
  ' Affectation icone au dossier racine
  Call trait_dos(ch_dos)
 
  ' Parcourir 1 dossier et ces sous-dossiers
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dos_rep = fs.GetFolder(ch_dos)
 
  ' Appel fonction recurante pour les sous-dossier
  Lit_dossier dos_rep, 1
 
End Sub
 
Sub Lit_dossier(ByRef dossier, ByVal niveau)
  For Each d In dossier.SubFolders
    ' Affectation icone au dossier racine
    Call trait_dos(d)
    Lit_dossier d, niveau + 1
   Next
End Sub
 
' Traitement des fichiers
Sub trait_dos(ByRef ch_dos)
  ' Rechercher le 1er fichier Icone "*.ico" d'un repertoire (visible et caché)
  Dim fic_ico As String
  fic_ico = Dir(ch_dos & "\" & "*.ico", vbHidden + vbSystem)  ' Extraire liste des fichiers "*.ico"
  If Len(fic_ico) < 1 Then
    Exit Sub
  Else
    Debug.Print ch_dos & fic_ico
  Else
  Dim MyFile As String: MyFile = ch_dos & "\" & fic_ico ': SetAttr MyFile, vbHidden
 
  ' Supprimer fichier "desktop.ini" si existant
  Set objFSO = New FileSystemObject
  On Error Resume Next ' si pas de fichier existant
  Set objMonFichier = objFSO.GetFile(ch_dos & "\desktop.ini")
  objMonFichier.Delete
 
  ' Créer fichier "desktop.ini" dans la racine du dossier
  Open ch_dos & "\" & "desktop" & ".ini" For Output As #1 ' For Binary
    Print #1, "; classe utilisé"
    Print #1, "[.ShellClassInfo]"
    Print #1, "; avertissement sur opération dossier"
    Print #1, "ConfirmFileOp=0"
    Print #1, "; Fichier Image pour icone"
    Print #1, "IconFile=" & fic_ico
    Print #1, "; Adresse icone d'IconFile si fichier mettre 0"
    Print #1, "IconIndex=0"
    Print #1, "; gestion partage dossier 0=oui et 1=non"
    Print #1, "Sharing = 0"
    Print #1, "; propriétaire fichier"
    Print #1, "Owner=Cancé"
  Close #1
  ' Modifier les attribut du fichier créer
  MyFile = ch_dos & "\" & "desktop" & ".ini"
  SetAttr MyFile, vbHidden + vbSystem '+ vbReadOnly
 
End Sub

Par avance merci