how to determine correct OLEObject Icon?

[bubba2413]

Hi everyone, have a little quandry here.

I've created a vba sub that will allow a user to insert an object (as an icon) into the selected cell. Generally these are Office or PDF files, but may also be images or text files.

The sub neatly formats the object to fit within the confines of the cell, and sets it to move/resize with the cell.

Pretty neat. User selects a target cell, and then clicks a form button that calls the macro. The standard file open dialog pops up, user selects the object, and clicks ok. Macro takes care of the rest.

OK. The problem:
If you do this manually, Excel knows how to find the proper icon for the target. PDF files get a PDF icon, word files get a word icon, etc. I just can't seem to figure out how to do that in code. If I use OLEObjects.Add and leave Iconfilename and iconindex blank I get an empty shape with no icon. The object is still there, and works ok ... just no icon.
In order to have an icon, I've resorted to using
[vba]
vFile = Application.GetOpenFilename("All Files,*.*", Title:="Select Artifact to insert")
If LCase(vFile) = "false" Then
Exit Sub
Else
lcl_a_fn = Split(vFile, "\")
lcl_vIconLabel = lcl_a_fn(UBound(lcl_a_fn))
End If
Set oNewObj = ActiveSheet.OLEObjects.Add(Filename:=vFile, _
Link:=False, DisplayAsIcon:=True, IconFileName:="explorer.exe", _
IconIndex:=1, IconLabel:=lcl_vIconLabel)
[/vba]

dows anyone know how I can determine the appropriate icon to use without knowing in advance what type of file will be selected?

 

[Cool blue]

dows anyone know how I can determine the appropriate icon to use without knowing in advance what type of file will be selected?

I don't think they have any non-causal features in VBA so, you can't know the file type before the user selects it. The only way you can know is if you only give them one option.

I don't understand why you don't just strip the file extension off the end of the file name. Just write a bit of code to do that. It's not really a workaround since what you want is impossible in the non-psychic realm.

And you could just collect the icons manually?

 

[mef1sto]

It's a pretty good idea if i only knew how to strip the file extension off, it worths a shot..might just do the trick...but how?!

 

[RoryA]

Not perfect, but should at least get you the right application icon:

Option Explicit

Const MAX_FILENAME_LEN = 260
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, _
                                                                           ByVal lpDirectory As String, _
                                                                           ByVal lpResult As String) As Long
Sub foo()
   Dim vFile
   Dim sExec                       As String
   Dim sFileName                   As String
   Dim oNewObj                     As Object

   vFile = Application.GetOpenFilename("All Files,*.*", Title:="Select Artifact to insert")
   If vFile = False Then
      Exit Sub
   Else
      sFileName = Mid(vFile, InStrRev(vFile, "\") + 1)
      sExec = FindApp(CStr(vFile))

      Set oNewObj = ActiveSheet.OLEObjects.Add(Filename:=vFile, _
                                               Link:=False, DisplayAsIcon:=True, IconFileName:=sExec, _
                                               IconIndex:=0, IconLabel:=sFileName)
   End If
End Sub

Function FindApp(sFile As String) As String
   Dim i As Integer, s2            As String

   'Check if the file exists
   If Dir(sFile) = "" Or sFile = "" Then
      MsgBox "File not found!", vbCritical
      Exit Function
   End If
   'Create a buffer
   s2 = String(MAX_FILENAME_LEN, 32)
   'Retrieve the name and handle of the executable, associated with this file
   i = FindExecutable(sFile, vbNullString, s2)
   If i > 32 Then
      FindApp = Left$(s2, InStr(s2, Chr$(0)) - 1)
   Else
      MsgBox "No association found !"
   End If
End Function

 

[mef1sto]

Hey Rory!
I have a post with this problem of uploading a file, could you give it a look and maybe change my code a little bit so i can eventually be able to save the label name i need (which includes the date the user has uploaded the file).
The thing is that after i save the file the icon changes automatically and the label becomes the name of the .msg file without the date i had added to the code like this :

Set oNewObj = ActiveSheet.OLEObjects.Add(Filename:=vFile, _
                                               Link:=False, DisplayAsIcon:=True, IconFileName:=sExec, _
                                               IconIndex:=0, IconLabel:=sFileName & Date)

Thanks a million! Cheers!

 

[RoryA]

I'm afraid I have no idea why the name would change after you save the file.

 

[mef1sto]

Yes i've noticed this effect for the .msg files, it didn't for the .pdf and .docx, the saving action didn't mess these files label names. So i'm not sure why these .msg files are special in some way. That's why i thought if we stripped the files type maybe this anomaly would't happen, but it was just a guess...

 

[mef1sto]

I've tried my code on a Win Xp OS and it seems that .msg files aren't messed up after all, running on this OS, so i think that the OS interferes somehow and probably recognizes that file format and automatically changes the icon and label at a time and results faulty. Could this be an explanation?

 

[RoryA]

I honestly have no idea, I'm afraid.