Changer l'icone d'un répertoire

Bonjour à tous,

Je recherche le code VBS pour changer l'icone d'un répertoire.

Merci pour votre aide.

Bonjour,

Est-ce que quelqu'un aurait un code à me proposer ?

Merci d'avance.

Bonjour,

voir la réponse apportée sur un autre forum …

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

Une piste
https://msdn.microsoft.com/fr-fr/lib...(v=vs.85).aspx

:salut:
Un coup d'oeil sur cette discussion : Comment changer l'icône d'un dossier avec une commande batch ?

:salut:
Voici la version en vbscript qui vous permet de créer un répertoire dans votre bureau et de changer son icône.
L'idée de base de ce script est basée principalement en deux :

1 ère condition : il faut créer un dossier et de le transformer en un dossier système.
2 ème condition : Créer le fichier système caché Desktop.ini avec les informations de l'icône dans ce dossier.

Code:

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
Option Explicit
Dim ws,Icon,strText,DesktopFolder,strFolder
Set ws = CreateObject("wscript.Shell")
DesktopFolder = ws.SpecialFolders("Desktop")
strFolder = DesktopFolder & "\Hackoo Folder Icon Changer"
Icon = "%systemroot%\system32\shell32.dll,-48"
strText = "[.ShellClassInfo]" & vbCrLf &_
"IconResource="& Icon & vbCrLf &_
"IconFile=%systemroot%\system32\shell32.dll"
'Create a folder on our desktop
Call SmartCreateFolder(strFolder)
'Transform our folder to a system folder
Call Execute("attrib +s " & DblQuote(strFolder))
Call Write_INI_File(strFolder,strText)
'********************************************************************
Sub SmartCreateFolder(strFolder)
    Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
    If oFSO.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(oFSO.GetParentFolderName(strFolder))
    End If
    oFSO.CreateFolder(strFolder)
    Set oFSO = Nothing    
End Sub
'********************************************************************
Function Execute(StrCmd)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
        MyCmd = "CMD /C " & StrCmd & ""
        Resultat = ws.run(MyCmd,0,True)
        If Resultat <> 0 Then
            MsgBox "Une erreur inconnue est survenue !",16,_
            "Une erreur inconnue est survenue !"
        End If
    Execute = Resultat
End Function
'********************************************************************
Sub Write_INI_File(PathFolder,strText)
Dim fs,ts,DesktopINI
Const ForWriting = 2
    DesktopINI = PathFolder & "\Desktop.ini"
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.FileExists(DesktopINI) Then 
        Call Execute("Attrib -R -H -S "& DblQuote(DesktopINI))
        fs.DeleteFile DesktopINI
    end If
    Set ts = fs.OpenTextFile(DesktopINI,ForWriting,True)
    ts.WriteLine strText
    ts.Close
'Transform the file Desktop.ini to a hidden and system file
    Call Execute("Attrib +R +H +S "& DblQuote(DesktopINI))
End Sub
'********************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************