VBA Assistance - Change the image/icon of embedded file

[pujo]

In VBA, I am embedding a file.
According to the file extension, I want to assign an image to the file. I am trying to alter the code found here Link:--> MrExcel - Attaching/ Embedding Files Using VBA
The change I want to make is to use one of the 4 images that I have on the admin sheet of the workbook.

I have tried a couple different methods but cannot get it to work.
Here is my latest try. Any assistance is greatly appreciated.

-Pujo

'https://www.mrexcel.com/forum/excel-questions/1020429-attaching-embedding-files-using-vba.html
Sub Insert()
  Dim iconToUse As String, fullFileName As String
  Dim FNExtension As String
  Dim o As OLEObject
  
  fullFileName = Application.GetOpenFilename("*.*, All Files", , , , False)
  
  If fullFileName = "False" Then Exit Sub ' user cancelled
  
  'choose an icon based on filename extension
  'get all after last "." in filename
  FNExtension = Right(fullFileName, Len(fullFileName) - _
  InStrRev(fullFileName, "."))
  
  'select icon based on filename extension
  Select Case UCase(FNExtension)
    Case Is = "TXT" 'NotePad
      iconToUse = Sheet7.Shapes("NoteIcon")
      
    Case Is = "XLS", "XLSM", "XLSX" 'Excel
      iconToUse = Sheet7.Shapes("ExcelIcon")
      
    Case Is = "DOC", "DOCX", "DOT" 'Excel
      iconToUse = Sheet7.Shapes("WordIcon")
      
    Case Is = "PDF" 'Acrobat PDF
      iconToUse = Worksheets("Admin").Shapes("PdfIcon")
      
    Case Else
      'this is a generic icon
      iconToUse = Sheet7.Shapes("GenericIcon")
  End Select
End Sub

And the Function

Function ExePath(lpFile As String) As String
   Dim lpDirectory As String, sExePath As String, rc As Long
   lpDirectory = "\"
   sExePath = Space(255)
   rc = FindExecutable(lpFile, lpDirectory, sExePath)
   sExePath = Left$(sExePath, InStr(sExePath, Chr$(0)) - 1)
  ExePath = sExePath
End Function

 

[Dan_W]

Hi. There are a few important differences between your code and Kenneth's code. First, you're missing the key API:

#If Win64 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.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If

I have converted it into 64bit and provided both above to make your code compatible with different systems, but that said I don't understand what you're wanting to do with the FindExe Function when you appear to have taken it out of the main code.

Also, youhave skipped the critically important OleObjects.Add method:

Set o = ActiveSheet.OLEObjects.Add(Filename:=fullFileName, Link:=False, DisplayAsIcon:=True, IconFileName:=iconToUse, IconIndex:=0, IconLabel:="Attachment 1")

Which is where the icon is set. But as you can see, it is expecting an IconFileName and not a shape object. If you saved those images as ICO icon files, then you could make this work.

 

[pujo]

Yes,
I have tried a bunch of different was to accomplice this which is why some of the code is removed.
With that being said, All I am trying to accomplish is embed a file to a worksheet change its icon to an image I have on the admin worksheet according to the extension.

 

[Dan_W]

Yes, I understand that, but as I said "But as you can see, it is expecting an IconFileName and not a shape object. If you saved those images as ICO icon files, then you could make this work." You need to be able to provide them as ICO icon files.

 

[pujo]

Yes, I understand that, but as I said "But as you can see, it is expecting an IconFileName and not a shape object. If you saved those images as ICO icon files, then you could make this work." You need to be able to provide them as ICO icon files.

Sorry,
I did not completely understand what you were saying.
Let me give that a try.

-Pujo

 

[pujo]

Runtime error: 438
I may have to look for another way to embed and use the images I have stored in the workbook.

-Pujo