Extracting an embedded ico file

Dean76

New Member
Joined
Apr 17, 2016
Messages
34
Hi,

I am currently working on a project where an excel file will create a folder, save itself as a hidden file and create a shortcut to itself within that folder. All easy enough. The one thing that I am trying to do is to use a custom icon for the shortcut file, however the main file will be sent to other users, who will run this 'setup' program to create the folder etc on their desktop and I am trying to find a way to include the icon file within the original excel workbook.
I had the idea of embedding the ico file within a worksheet, then extracting the embedded file into the new folder once created, however an intensive search on how to do this has left me coming up with blanks.

Hoping you guys can help me answer three main questions I have
1. Is this possible with VBA?
2. How can I do it!
and
3. Is there a better way?

Appreciate any assistance.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,898
Office Version
  1. 2013
Platform
  1. Windows
I looked around for solutions and after a lot of searching I found this code. It uses a loop but doesn't matter if you only have 1 object.

vba - Extract OLE object data in Microsoft Office without OLE application - Stack Overflow

I tested it and it worked for me.
It copied an icon (license26.ico) embedded as a packager shell object (Insert -> Object -> Create from file) from my worksheet to a specified folder.
(Link to object/display as icon - neither selected)

If it doesn't work ---- I don't know : ).
vba - Shell.Application paste method does not create a file in the target folder - Stack Overflow

Code:
Sub Macro1()

For Each Shp In Sheet4.OLEObjects   '----------check worksheet
If InStr(1, Shp.Name, "Object", 1) Then 
Shp.Copy
' this code paste Embedded Object to folder
CreateObject("Shell.Application").Namespace("c:\junk\").Self.InvokeVerb "Paste" '------ check folder
End If
Next Shp

End Sub
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,898
Office Version
  1. 2013
Platform
  1. Windows
Hi,

Yes I saw that one and avoided it...

Not sure why the object copy would fail.

Any Poster?


If you are bored try adding the file with code see it you get the same issue when it tries to copy.

Code:
Sub Macro1()
Worksheets("Sheet4").OLEObjects.Add Filename:="c:\licence26.ico" '--- filepath

For Each Shp In Sheet4.OLEObjects   '----------check worksheet
If InStr(1, Shp.Name, "Object", 1) Then 
Shp.Copy
' this code paste Embedded Object to folder
CreateObject("Shell.Application").Namespace("c:\junk\").Self.InvokeVerb "Paste" '------ check folder
End If
Next Shp
End Sub

Either way glad you are sorted.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,222
Messages
5,768,898
Members
425,501
Latest member
sunderlalrwr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top