I am trying to use the shell32 API, SHGetFileInfo to load an Image control with a file’s associated icon. Any sample code that I’ve found uses a PictureBox because it has a Window’s handle, but VBA UserForms do not have a PictureBox, they only have Image controls.
Another option would be to use an ImageList, but I cannot find any code for it either that doesn’t use a PictureBox.
I wrote a “simple” test to just display an icon on a blank form without any controls. It gives some numbers for the SHGetFileInfo, but the form is blank.
The data structures go into a module:
Option Explicit Public Const MAX_PATH As Long = 260 Public Const SHGFI_DISPLAYNAME = &H200 Public Const SHGFI_EXETYPE = &H2000 Public Const SHGFI_SYSICONINDEX = &H4000 'system icon index Public Const SHGFI_LARGEICON = &H0 'large icon Public Const SHGFI_SMALLICON = &H1 'small icon Public Const ILD_TRANSPARENT = &H1 'display transparent Public Const SHGFI_SHELLICONSIZE = &H4 Public Const SHGFI_TYPENAME = &H400 Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _ SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or _ SHGFI_DISPLAYNAME Or SHGFI_EXETYPE Public Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * MAX_PATH szTypeName As String * 80 End Type Public Declare Function FindWindow Lib "user32.dll" _ Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function ImageList_Draw Lib "comctl32" _ (ByVal himl&, _ ByVal i&, _ ByVal hDCDest&, _ ByVal x&, _ ByVal y&, _ ByVal Flags&) As Long Public Declare Function SHGetFileInfo Lib "shell32" _ Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFO, _ ByVal cbSizeFileInfo As Long, _ ByVal uFlags As Long) As Long Public Declare Function DrawIconEx Lib "user32" _ (ByVal hdc As Long, _ ByVal xLeft As Long, _ ByVal yTop As Long, _ ByVal hIcon As Long, _ ByVal cxWidth As Long, _ ByVal cyWidth As Long, _ ByVal istepIfAniCur As Long, _ ByVal hbrFlickerFreeDraw As Long, _ ByVal diFlags As Long) As Long
The UserForm (I’m in Excel) is blank with the following code:
Option Explicit Private Sub UserForm_Initialize() 'Get UserForm window handle Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame" Dim hWndForm As Long, hImgSmall As Long hWndForm = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption) Dim sFile As String sFile = "E:Documents and Settingssbarrett.CACIMy DocumentsA.txt" Dim hIconSmall As Long Dim shinfo As SHFILEINFO hImgSmall = SHGetFileInfo(sFile, ByVal 0&, shinfo, Len(shinfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON) Dim ll As Long ll = ImageList_Draw(ByVal hImgSmall, ByVal shinfo.iIcon, ByVal hWndForm, ByVal 10&, ByVal 10&, ILD_TRANSPARENT) End Sub
Any help would be greatly appreciated! –Sam