Very simple, powerfull and handy routine for correct icon indexing from the shell

This routine is by far the most powerfull, simple and robust routine for indexing of shellicons I have come up with for FS objects as well as Virtual objects. Works from Win XP and above. And no need of any typelibs.
Also very effortless in memory usage. No time & memory consuming extractions at all.
So get rid of your existing routines and replace it with this tiny one.
Handle both normal and open icons.
You can also use it for all sizes you wish ie small, medium, large, extra large or custom size. (It handles "under the hood" IImageList interface which allows resizing on the fly without clearing the imagelist).

Code:

---

Public Const S_OK = 0&
Public Const S_ERR = 1

Public Declare Function SHGetDesktopFolder Lib "shell32.dll" (ByRef ppshf As Long) As Long
Public Declare Function SHMapPIDLToSystemImageListIndex Lib "shell32.dll" (Byref pshf As Long, ByVal pidl As Long,Byref piIndex As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pidlorMem As Long)

Public Function IID_IShellFolder() As GUID
  Dim lpIID As GUID
 
  '000214E6-0000-0000-C000-000000000046
  lpIID.Data1 = &H214E6
  lpIID.Data2 = &H0
  lpIID.Data3 = &H0
  lpIID.Data4(0) = &HC0
  lpIID.Data4(1) = &H0
  lpIID.Data4(2) = &H0
  lpIID.Data4(3) = &H0
  lpIID.Data4(4) = &H0
  lpIID.Data4(5) = &H0
  lpIID.Data4(6) = &H0
  lpIID.Data4(7) = &H46
 
  IID_IShellFolder = lpIID
End Function

Public Function SHGetItemIconIndex(ByVal pidlItem As Long, ByRef nIconIndex As Long, Optional nOpenIconIndex As Long) As Long
  Dim pidl As Long
  Dim pidlChild As Long
  Dim ppISF As Long
  Dim nIconSize As Long
  Dim sIconFile As String

  pidl = pidlItem
 
  If pidl Then
      'You can put in if statement here if you feel for it. (If hr = S_OK Then)
      SHBindToParent pidl, IID_IShellFolder, ppISF, pidlChild
      If ppISF = 0 Then SHGetDesktopFolder ppISF
      nIconIndex = SHMapPIDLToSystemImageListIndex(ByVal ppISF, pidlChild, nOpenIconIndex)
     
      Debug.Print "nIconIndex: " & nIconIndex
      Debug.Print "nOpenIconIndex: " & nOpenIconIndex
     
      CoTaskMemFree pidl     
      CoTaskMemFree ppISF
      ppISF = 0

      If (nIconIndex <> -1) And (nOpenIconIndex <> -1) Then
        SHGetItemIconIndex = S_OK
      Else
        SHGetItemIconIndex = S_ERR
      End If
  End If

---

Happy Coding :wave:;)