Custom Icons for Folders

I need to change the "yellow folder" icon to a custom icon from within a VB6 program for user selected folder shortcuts.

The functionality of the PC Magazine utility "Folders" is basically what I need from within a program.

Any pointers really welcome
Roy LowAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

glass_cookieConnect With a Mentor Commented:
Here's another file for you over the net:


Description: Asign an icon to a folder

That's it!

PS. The link for the previous posting is this:

Richie_SimonettiIT OperationsCommented:
Ypu need to change the value stored in registry:


That  means take 3rd icon from shell32.dll.
You could change to a path where your custom ico is located.
If you have visual studio, there is a registry tool called
regtool5.dll that you can use to manage registry entries.

Here's an example for you over the net:


Description: Change windows default yellow color icon and set your own custom icon to any folder with this easy code.

That's it!

glass cookie : )
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Ryan ChongCommented:
Richie_SimonettiIT OperationsCommented:
MAYBE glass is right. My post doesn't work.
Roy LowAuthor Commented:
Thanks Glass
Easy when you know how but who'd have thought making a folder "System" was the key?
Roy LowAuthor Commented:
Thanks, see previous comment
Thanks for the points.  Happy programming : )
I think you could try this to refresh the custom folder icon :
Private Const WM_WININICHANGE = &H1A
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg

As Long, ByVal wParam As Long, lParam As Any) As Long
 whwnd = FindWindow("progMan", "program manager")
 SendMessage whwnd, WM_SETTINGCHANGE, 0, 0

Roy LowAuthor Commented:
I now have the solution to refreshing the folder icon!!

I do it by making a separate .exe (ShowCustomIcon.exe) which I then call using Shell as in dummy = Shell(ShowCustomIcon Myfoldername).

If you don't do this, repeated calls to the same code from within the same program just don't work but the first one does!!!???

Paste the following code into a project (no form) and compile it.

The calls to get the PIDL for DeskTop may not be necessary but the use of the undocumented API
certainly is.

Thanks to many people for help see documentation.

'   ************************************************************************
'   Declarations to support the call to SHChangeNotify which informs the system
'   of changes to the Shell, specifically to the folder icon

Declare Sub SHChangeNotify Lib "shell32" _
                        (ByVal wEventId As SHCN_EventIDs, _
                        ByVal uFlags As SHCN_ItemFlags, _
                        ByVal dwItem1 As Long, _
                        ByVal dwItem2 As Long)

'   undocumented API function as described by
' Brad Martinez,

'solution suggested by Randy Birch
'                       MVP Visual Basic


Declare Function SHSimpleIDListFromPath Lib _
    "shell32" Alias "#162" _
    (ByVal szPath As String) As Long
Public Const MAX_PATH = 260
Public Const SHCONTF_FOLDERS = 32


  ' Fully qualified pidl (relative to the desktop folder) of the folder to monitor changes in.
  ' 0 can also be specifed for the desktop folder.
   pidl As Long
  ' Value specifying whether changes in the folder's subfolders trigger a change notification
  '  event (it's actually a Boolean, but we'll go Long because of VB's DWORD struct alignment).
   bWatchSubFolders As Long
 End Type
 Public m_pidlDesktop As Long   ' the desktop's pidl

Public Enum SHCN_EventIDs
 SHCNE_RENAMEITEM = &H1      ' (D) A nonfolder item has been renamed.
 SHCNE_CREATE = &H2                ' (D) A nonfolder item has been created.
 SHCNE_DELETE = &H4                ' (D) A nonfolder item has been deleted.
 SHCNE_MKDIR = &H8                  ' (D) A folder item has been created.
 SHCNE_RMDIR = &H10                ' (D) A folder item has been removed.
 SHCNE_MEDIAINSERTED = &H20     ' (G) Storage media has been inserted into a drive.
 SHCNE_MEDIAREMOVED = &H40      ' (G) Storage media has been removed from a drive.
 SHCNE_DRIVEREMOVED = &H80      ' (G) A drive has been removed.
 SHCNE_DRIVEADD = &H100              ' (G) A drive has been added.
 SHCNE_NETSHARE = &H200             ' A folder on the local computer is being shared via the network.
 SHCNE_NETUNSHARE = &H400        ' A folder on the local computer is no longer being shared via the network.
 SHCNE_ATTRIBUTES = &H800           ' (D) The attributes of an item or folder have changed.
 SHCNE_UPDATEDIR = &H1000          ' (D) The contents of an existing folder have changed, but the folder still exists and has not been renamed.
 SHCNE_UPDATEITEM = &H2000                  ' (D) An existing nonfolder item has changed, but the item still exists and has not been renamed.
 SHCNE_SERVERDISCONNECT = &H4000   ' The computer has disconnected from a server.
 SHCNE_UPDATEIMAGE = &H8000&              ' (G) An image in the system image list has changed.
 SHCNE_DRIVEADDGUI = &H10000               ' (G) A drive has been added and the shell should create a new window for the drive.
 SHCNE_RENAMEFOLDER = &H20000          ' (D) The name of a folder has changed.
 SHCNE_FREESPACE = &H40000                   ' (G) The amount of free space on a drive has changed.

#If (WIN32_IE >= &H400) Then
 ' (G) SHCNE_EXTENDED_EVENT:  the extended event is identified in dwItem1,
 ' packed in LPITEMIDLIST format (same as SHCNF_DWORD packing).
 ' Unlike the standard events, the extended events are ORDINALs, so we
 ' don't run out of bits.  Extended events follow the SHCNEE_* naming
 ' convention.
 ' The dwItem2 parameter varies according to the extended event.
#End If     ' WIN32_IE >= &H0400

 SHCNE_ASSOCCHANGED = &H8000000       ' (G) A file type association has changed.

 SHCNE_DISKEVENTS = &H2381F                  ' Specifies a combination of all of the disk event identifiers. (D)
 SHCNE_GLOBALEVENTS = &HC0581E0        ' Specifies a combination of all of the global event identifiers. (G)
 SHCNE_INTERRUPT = &H80000000              ' The specified event occurred as a result of a system interrupt.
                                                                           ' It is stripped out before the clients of SHCNNotify_ see it.
End Enum

' Notification flags

' uFlags & SHCNF_TYPE is an ID which indicates what dwItem1 and dwItem2 mean
Public Enum SHCN_ItemFlags
 SHCNF_IDLIST = &H0                ' LPITEMIDLIST
 SHCNF_PATHA = &H1               ' path name
 SHCNF_PRINTERA = &H2         ' printer friendly name
 SHCNF_DWORD = &H3             ' DWORD
 SHCNF_PATHW = &H5              ' path name
 SHCNF_PRINTERW = &H6        ' printer friendly name
 ' Flushes the system event buffer. The function does not return until the system is
 ' finished processing the given event.
 ' Flushes the system event buffer. The function returns immediately regardless of
 ' whether the system is finished processing the given event.

#End If

End Enum
' ====================================================================
' SHGetSpecialFolderLocation

' Retrieves the location of a special (system) folder.
' Returns NOERROR if successful or an OLE-defined error result otherwise.
 Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                               (ByVal hwndOwner As Long, _
                               ByVal nFolder As SHSpecialFolderIDs, _
                               pidl As Long) As Long

' Special folder values for SHGetSpecialFolderLocation and
' SHGetSpecialFolderPath (Shell32.dll v4.71)
 Public Enum SHSpecialFolderIDs
   CSIDL_ALTSTARTUP = &H1D                      ' ' DBCS
End Enum
' ====================================================================
' SHGetSpecialFolderLocation

' Retrieves information about an object in the file system, such as a file,
' a folder, a directory, or a drive root.
Public Type SHFILEINFOBYTE   ' sfib
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName(1 To MAX_PATH) As Byte
  szTypeName(1 To 80) As Byte
End Type
Enum SHGFI_flags
  SHGFI_LARGEICON = &H0             ' sfi.hIcon is large icon
  SHGFI_SMALLICON = &H1             ' sfi.hIcon is small icon
  SHGFI_OPENICON = &H2               ' sfi.hIcon is open icon
  SHGFI_SHELLICONSIZE = &H4      ' sfi.hIcon is shell size (not system size), rtns BOOL
  SHGFI_PIDL = &H8                          ' pszPath is pidl, rtns BOOL
  SHGFI_USEFILEATTRIBUTES = &H10   ' pretent pszPath exists, rtns BOOL
  SHGFI_ICON = &H100                     ' fills sfi.hIcon, rtns BOOL, use DestroyIcon
  SHGFI_DISPLAYNAME = &H200     ' isf.szDisplayName is filled, rtns BOOL
  SHGFI_TYPENAME = &H400           ' isf.szTypeName is filled, rtns BOOL
  SHGFI_ATTRIBUTES = &H800         ' rtns IShellFolder::GetAttributesOf  SFGAO_* flags
  SHGFI_ICONLOCATION = &H1000   ' fills sfi.szDisplayName with filename
                                                             ' containing the icon, rtns BOOL
  SHGFI_EXETYPE = &H2000              ' rtns two ASCII chars of exe type
  SHGFI_SYSICONINDEX = &H4000   ' sfi.iIcon is sys il icon index, rtns hImagelist
  SHGFI_LINKOVERLAY = &H8000     ' add shortcut overlay to sfi.hIcon
  SHGFI_SELECTED = &H10000         ' sfi.hIcon is selected icon
End Enum
Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pidl As Any, _
                              ByVal dwFileAttributes As Long, _
                              psfib As SHFILEINFOBYTE, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

' If pidl is invalid, SHGetFileInfo can very easily blow up when filling the
' szDisplayName and szTypeName string members of the SHFILEINFO'
' struct, so we'll define these members as Byte.

' Frees memory allocated by the shell (pidls)
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Sub Main()
Dim CommandString As String
If Command = "" Then
    MsgBox "No Folder path in the command string, the custom folder cannot be shown", vbCritical, "Folder Manager"
    'CommandString = InputBox("Enter Folder name", "Folder Manager")
    'If CommandString = "" Then End
    'CommandString = InputBox("Call to ChangeFolderIcon with ", "Enter Folder Name", Command)
    CommandString = Command
    'If CommandString = "" Then End
End If
ChangeFolderIcon CommandString
End Sub

 Public Function GetPIDLFromFolderID(hOwner As Long, _
                                                             nFolder As SHSpecialFolderIDs) As Long

   Dim pidl As Long
   If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then
     GetPIDLFromFolderID = pidl
   End If
 End Function
Function PidlFromPath(sPath As String) As Long
    Dim pidl As Long, f As Long, PathStr As String
    PathStr = sPath
    '   remove trailing backslash
    Do While Right(PathStr, 1) = "\"
        PathStr = Left$(PathStr, Len(PathStr) - 1)
    f = SHSimpleIDListFromPath(PathStr)

    If f > 0 Then PidlFromPath = f
End Function
Function PidlFromSpecialFolder( _
                Optional ByVal csidl As SHSpecialFolderIDs = CSIDL_DESKTOP, _
                Optional ByVal hWnd As Long = 0) As Long
    On Error Resume Next
    Dim pidl As Long
    SHGetSpecialFolderLocation hWnd, csidl, pidl
    If Err = 0 Then PidlFromSpecialFolder = pidl
End Function

Sub ChangeFolderIcon(ShowFolder As String)
'   Shows the new icon instead of pressing F5
'MsgBox "The system will now re-set the icon for " & vbcrlf & ShowFolder & vbcrlf & "which you have just categorised", vbInformation, SystemTitle$
Dim Finfo As Long, dwFileAttributes As Long, psfib As SHFILEINFOBYTE
Dim cbFileInfo As Long, uFlags As SHGFI_flags, FolderPidl As Long, FPathStr As String
'   ********************************************************************
'   ********************************************************************
'get pidl for desktop folder
Dim DeskTopPidl As Long
DeskTopPidl = PidlFromSpecialFolder
' Get the pidl for the folder.
FPathStr = ShowFolder
'remove trailing backslashes
Do While Right(FPathStr, 1) = "\"
    FPathStr = Left(FPathStr, Len(FPathStr) - 1)
FolderPidl = PidlFromPath(FPathStr)
'   get the info for this folder
  'SHGetFileInfo(pszPath, 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);

Finfo = SHGetFileInfo(FPathStr, dwFileAttributes, psfib, cbFileInfo, uFlags)
Call CoTaskMemFree(DeskTopPidl)
Call CoTaskMemFree(FolderPidl)
End Sub
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.