Option Explicit
 
' Benötigte API-Deklarationen
Private Const MAX_PATH As Long = 260
 
Private Type SHFILEINFO
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
 
Private Declare Function SHGetFileInfo Lib "shell32.dll" _
  Alias "SHGetFileInfoA" ( _
  ByVal pszPath As String, _
  ByVal dwFileAttributes As Long, _
  ByRef psfi As SHFILEINFO, _
  ByVal cbFileInfo As Long, _
  ByVal uFlags As Long) As Long
 
Private Type tGUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
 
Private Type PictDesc
  cbSizeofStruct As Long
  picType As Long
  hImage As Long
  xExt As Long
  yExt As Long
End Type
 
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
   ByRef lpPictDesc As PictDesc, _
   ByRef riid As tGUID, _
   ByVal fOwn As Long, _
   ByRef lplpvObj As IPicture) As Long
 
Public Enum FileIconSize
  IconSmall = &H101
  IconLarge = &H100
End Enum

' Icon einer Datei ermitteln
Public Function GetFileIcon(ByVal sFile As String, _
  Optional ByVal nSize As FileIconSize = IconSmall) As Picture
 
  Dim tPic As PictDesc
  Dim tGUID As tGUID
  Dim tInfo As SHFILEINFO
  Dim oPic As Picture
  Dim nResult As Long
 
  ' File-Informationen lesen
  Call SHGetFileInfo(sFile, 2, tInfo, Len(tInfo), nSize)
 
  ' Standard-Picture erstellen
  With tPic
    .cbSizeofStruct = Len(tPic)
    .picType = vbPicTypeIcon
    .hImage = tInfo.hIcon
  End With
  tGUID.Data1 = &H20400
  tGUID.Data4(0) = &HC0
  tGUID.Data4(7) = &H46
  nResult = OleCreatePictureIndirect(tPic, tGUID, 1, oPic)
 
  ' Picture zurückgeben
  Set GetFileIcon = oPic
End Function

With ImageList1.ListImages
  .Add , , GetFileIcon("c:\winnt\notepad.exe", IconSmall)
  .Add , , .Item(.Count).ExtractIcon
  .Remove .Count - 1
End With

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de