Code to insert file attachment as icon, to defined cell

[TashaWard]

Hi,
Pretty new to VBA, anything I've learnt so far has come from threads on this page - it's amazing!
Needing some help that I haven't seen an answer for so far
I need to add a button to a workbook which will allow the user to add a file (this will vary in extension and file name)
I also need this file to be added as an icon and attached to a particular cell for other users to open
So far I have:

Application.Dialogs(xlDialogInsertObject).Show
ActiveSheet.OLEObjects.Add(FileName:=ftopen, Link:=False, _
DisplayAsIcon:=True, IconFileName:=MyFileName, Link:=True, _
IconIndex:=0, IconLabel:=MyFileName).Show

I've tried adding in a line to dictate where the icon should be added - it hasn't worked
Also, this has only seemed to add the file path, not the file itself
Can someone help me write the code to do what I need it to?
TIA

 

[Jaafar Tribak]

Reading registry is good for me.
But alternatively FindExecutable API function can be used to get icon FileName:

Option Explicit
 
#If  VBA7 Then
  Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As LongPtr
#Else 
  Private Declare Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal sResult As String) As Long
#End If
 
Function IconFName(PathName As String) As String
  Dim i As Long, s As String
  s = Space(260)
  i = InStrRev(PathName, "")
  If i > 0 Then
    If FindExecutable(Mid(PathName, i + 1), Left(PathName, i), s) > 32 Then
      IconFName = Left(s, InStr(s, Chr(0)) - 1)
    End If
  End If
End Function
 
Public Sub Insert_File_With_Icon()
 
  Dim initialFolder As String
  Dim file As String
  Dim destCell As Range
 
  initialFolder = ThisWorkbook.Path    'or a specific folder - "C:\Temp\Excel"
 
  Set destCell = ActiveCell   'or a specific cell - ActiveSheet.Range("G10")
 
  With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = initialFolder
    .AllowMultiSelect = False
    .Filters.Add "All files", "*.*", 1
 
    If .Show Then
      file = .SelectedItems(1)
      destCell.Worksheet.OLEObjects.Add FileName:=file, _
                                        Link:=False, _
                                        DisplayAsIcon:=True, _
                                        IconFileName:=IconFName(file), _
                                        IconIndex:=0, _
                                        IconLabel:=Mid(file, InStrRev(file, Chr(92)) + 1)
    End If
 
  End With
 
End Sub

By the way, some file types can't be embedded into Excel, for example - XLL. Manual embedding will help to understand why code does not work.

Thanks Vladimir,

That's close but not quite exact .. The icon being displayed is not that of the data file but rather that of the associated executable.

 

[ZVI]

There is a forum problem to post some symbols now.
So in the code of function IconFName this code line:
i = InStrRev(PathName, "")
should be replaced by that one:
i = InStrRev(PathName, Chr(92))

 

[ZVI]

That's close but not quite exact .. The icon being displayed is not that of the data file but rather that of the associated executable.

Jaafar you are correct - the icon just replicates the executable one.

 

[Jaafar Tribak]

I think maybe I should just give up on this SHGetFileInfo API as there seems to have a bug which causes the szDisplayName and szTypeName members to return an empty string instead of the icon file path/file extension.

Reading the Registry works fine .. I just wanted to find a 'simpler' alternative out of curiosity.

 

[ZVI]

In szDisplayName is just filename with extension, in szTypeName is the local type name. No Icon File name in it.

Option Explicit
 
#If VBA7 Then
  Type SHFILEINFO
    hIcon As LongPtr                '  out: icon
    iIcon As Long                   '  out: icon index
    dwAttributes As Long            '  out: SFGAO_ flags
    szDisplayName As String * 260   '  out: display name (or path)
    szTypeName As String * 80       '  out: type name
  End Type
  Declare PtrSafe Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As LongPtr
#Else 
  Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * 260
    szTypeName As String * 80
  End Type
  Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As Any, ByVal dwFileAttributes As Long, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
#End If
 
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H0
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const SHGFI_ATTRIBUTES = &H800
Const SHGFI_DISPLAYNAME = &H200
Const SHGFI_EXETYPE = &H2000
Const SHGFI_ICON = &H100
Const SHGFI_ICONLOCATION = &H1000
Const SHGFI_LARGEICON = &H0
Const SHGFI_LINKOVERLAY = &H8000
Const SHGFI_OPENICON = &H2
Const SHGFI_PIDL = &H8
Const SHGFI_SELECTED = &H10000
Const SHGFI_SHELLICONSIZE = &H4
Const SHGFI_SMALLICON = &H1
Const SHGFI_SYSICONINDEX = &H4000
Const SHGFI_TYPENAME = &H400
Const SHGFI_USEFILEATTRIBUTES = &H10
 
Sub TestSHGetFileInfo()
  Dim info As SHFILEINFO
  Dim retval As Long
  Const FileName As String = "C:\Temp\Test.pdf"
  retval = SHGetFileInfo(FileName, FILE_ATTRIBUTE_NORMAL, info, Len(info), SHGFI_ICON Or SHGFI_TYPENAME Or SHGFI_DISPLAYNAME)
  Debug.Print "SHGetFileInfo " & FileName
  Debug.Print "Display name: " & info.szDisplayName
  Debug.Print "Type Descr:   " & info.szTypeName
End Sub

Seems the only way is in getting of correct IconFileName from the handle hIcon and the index iIcon. But not sure how this can be done.

 

[Jaafar Tribak]

Thanks Vladimir for the interest.

From the MSDN

SHGFI_ICONLOCATION (0x000001000)
Retrieve the name of the file that contains the icon representing the file specified by pszPath, as returned by the IExtractIcon::GetIconLocation method of the file's icon handler. Also retrieve the icon index within that file. The name of the file containing the icon is copied to the szDisplayName member of the structure specified by psfi. The icon's index is copied to that structure's iIcon member.

szDisplayName returns different info according to the flag being passed .. According to the above MS documentation, In order to return the icon file location in the szDisplayName member, we should pass the SHGFI_ICONLOCATION flag

But it just doesn't work .. It returns an empty string !!

 

[ZVI]

Thank you Jaafar,
I read that article in MSDN and have to confirm it does not work.