Hi Anton,
be careful with this code (only tested with zip and txt), but you can try:

In a standard module:
Option Explicit
Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function _
GlobalSize& Lib "kernel32" (ByVal hMem&)
Private Declare Function _
GlobalLock& Lib "kernel32" (ByVal hMem&)
Private Declare Function _
GlobalUnlock& Lib "kernel32" (ByVal hMem&)
Private Declare Sub CopyMem Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

Private Function GetData(ByVal Format&, abData() As Byte) As Boolean
Dim hWnd&, Size&, Ptr&
If OpenClipboard(0&) Then
' Get memory handle to the data
hWnd = GetClipboardData(Format)
' Get size of this memory block
If hWnd Then Size = GlobalSize(hWnd)
' Get pointer to the locked memory
If Size Then Ptr = GlobalLock(hWnd)
If Ptr Then
' Resize the byte array to hold the data
ReDim abData(0 To Size - 1) As Byte
' Copy from the pointer into the array
CopyMem abData(0), ByVal Ptr, Size
' Unlock the memory
Call GlobalUnlock(hWnd)
GetData = True
End If
EmptyClipboard
CloseClipboard
DoEvents
End If
End Function

Sub SaveEmbeddedFile()
Dim Sh As Shape, B() As Byte, Pos&, F&
For Each Sh In ActiveSheet.Shapes
If InStr(1, Sh.Name, "Object", 1) Then
Sh.Copy ' (49156 = Native format)
If Not GetData(49156, B) Then Exit Sub
Dim Buffer$, FileName$, Extension$
Buffer = StrConv(B, vbUnicode)
FileName = "Embedded"
Extension = ".emb"
Pos = InStr(3, Buffer, ".", 1)
If Pos Then
FileName = Mid$(Buffer, 3, Pos - 3)
Extension = Mid$(Buffer, Pos, 4)
End If
FileName = "c:\" & FileName & Extension
If Len(Dir(FileName)) Then Kill FileName
F = FreeFile
Open FileName For Binary As #F
Put #F, , B
Close #F
End If
Next Sh
End Sub

Regards,
MP

"Anton Rapoport" a écrit dans le
message de news: ...
Hello, Excel experts

I have faced the following problem (I will not be surprised if it cannot
be
solved at all in Excel VBA):

Excel allows to embed an OLE object into a worsheet. Manually a user has
to
click "Insert" from the main menu, then "Object", then choose the "Create
from file" tab and then select a file to embed. A user is free to embed
any
(generic) file with any file extension, e.g. test.zip or test.tst or
whatever
which may not be necessarily associated with a Windows application.

My problem is I need to save the embedded file back to a hard disk.
Manually
the user has to right-click on the embedded file icon, then choose
"Package
Object", then "Edit Package". After that a separate "Object Packager"
window
will appear. There in the "Object pckager" window the user clicks "File"
and
"Save contents" to save the embedded file as a file back to a
user-selected
location.
But how to do it from VBA code? How can I save a file embedded as object
into the sheet back to hard disk?

Thanks a lot for your help in advance,

Anton


--
Tonioant