VBA to Save as/extract file inserted as OLEObjects in Worksheet.

[pedie]

Hi,

Please help me with a vba code to Save as/Extract OLEObjects/file inserted in Worksheet.
the below code inserts the file into the sheet but now i want to be able to use this file by extracting it to a folder in C drive.

Thanks in advance.
Regards Pedie

[/FONT][FONT=courier new]    ActiveSheet.OLEObjects.Add(FileName:= _[/FONT]
[FONT=courier new]        "C:\Users\x\Desktop\DeskItems\mygif.gif", Link:=False, DisplayAsIcon:= _[/FONT]
[FONT=courier new]        True, IconFileName:="C:\Program Files (x86)\Internet Explorer\iexplore.exe", _[/FONT]
[FONT=courier new]        IconIndex:=1, IconLabel:="C:\Users\x\Desktop\DeskItems\mygif.gif"). _[/FONT]
[FONT=courier new]        Select[/FONT]
[FONT=courier new]    Range("K14").Select[/FONT]
[FONT=courier new]    ActiveWorkbook.Save

 

[sijpie]

Unfortunately I can't help direct, but have a look at these posts, perhaps they are of some help. And if the answerers are still active on the site, send them a personal message to ask their help.

http://www.mrexcel.com/forum/excel-questions/357212-deleting-embedded-file.html
http://www.mrexcel.com/forum/excel-questions/22140-writing-embeded-object.html
http://www.mrexcel.com/forum/excel-questions/666270-proper-way-replace-delete-embedded-object.html
http://www.mrexcel.com/forum/excel-questions/64180-how-can-i-export-package-object-excel.html
http://www.mrexcel.com/forum/excel-questions/465154-macro-open-embedded-file.html

The last one opens the embedded object, and you could then save it from there??

 

[Jaafar Tribak]

The only way I know of is to have the file bytes of the embeeded object stored somewhere in the workbook like in worksheet cells and then rebuild the file from the bytes and save in the desired folder with standard VBA I/O functions.
Notice that if you select the oleobject and copy it to the clipboard by pressing Ctrl+C then you can paste it in any shell folder - I would love to see this done programatically as this would be much more elegant and cleaner than storing the bytes and rebuilding the file as I suggested.

 

[pedie]

Thanks guys for valuable input though i still cant make it work.
My goal here is to use the embedded file/pic in the worksheet in userform...like below..

'open object in the browser...
    Dim oOLE As OLEObject
    Set oOLE = ActiveSheet.OLEObjects("Object 3")
    oOLE.Verb xlPrimary

'use the file opened in the temp folder.
Me.WebBrowser1.Navigate2 mygif'or full file name

now i dont want to open the embedded file/pic in the browser in visible mode...
please advice.

regards,
Pedie

 

[Jaafar Tribak]

As I said, the only way I know of is to extract the bytes form the gif file and store them in a hidden worksheet then re-build the gif from the stored bytes ,save the gif to disk and load it in the webbrowser from there....it is a rather long winded process but I don't know any other way.

Do you have the gif file on disk as well ? and is it just one gif file we are talking about or many ?

 

[pedie]

Jaafar, I only have 1 gif file. i do not have it in my disk now. " extract the bytes form the gif file and store them in a hidden worksheet then re-build the gif from the stored bytes" i think you'll have to show me some example. I'm not an expert.

Regards,
Pedie

 

[Jaafar Tribak]

Workbook example


Ok - follow these steps :

1- Manually select and copy the worksheet embeeded object(gif) to the clipboard.
2- Paste the clipboard content to the C: drive - You should now have the gif file saved to disk in the C folder.
3- Change the name of the pasted gif file to a.gif
4- add a new sheet to the workbook and name it : Gif_Bytes
5- Hide the newly added sheet - set its visible property to xlSheetVeryHidden
6- Put this code in a new standard module and run the EmbedGif Macro :

Option Explicit

Sub EmbedGif()
    Dim Bytes() As Byte
    Dim FileNum As Integer
    Dim Var() As Variant
    Const Gif_Path_Name As String = "C:\a.gif"

    FileNum = FreeFile
    
    ReDim Bytes(1 To FileLen(Gif_Path_Name))

    Open Gif_Path_Name For Binary As #FileNum
        Get #FileNum, 1, Bytes
    Close FileNum
    
        With Worksheets("Gif_Bytes")
            .Range(.Cells(1, 1), .Cells(UBound(Bytes), 1)).Value = Application.Transpose(Bytes)
        End With
        ThisWorkbook.Save
End Sub

By now you should have all the gif file bytes extracted and stored in column A in the hidden sheet.


7- Put this code in the Userform module :

Option Explicit

Private Sub UserForm_Initialize()
    CreateGifFile Environ("temp") & "\MyGif.gif"
    Me.WebBrowser1.Navigate2 Environ("temp") & "\MyGif.gif"
End Sub

Private Sub UserForm_Terminate()
    Kill Environ("temp") & "\MyGif.gif"
End Sub

Private Sub CreateGifFile(ByVal GifFile As String)
    Dim Bytes() As Byte
    Dim FileNum As Integer
    Dim Var() As Variant
    Dim x As Long
    
    Var = ThisWorkbook.Worksheets("Gif_Bytes").UsedRange.Value
     
    ReDim Bytes(LBound(Var) To UBound(Var))
    For x = LBound(Var) To UBound(Var)
        Bytes(x) = CByte(Var(x, 1))
    Next
    
    FileNum = FreeFile
    Open GifFile For Binary As #FileNum
        Put #FileNum, 1, Bytes
    Close FileNum
    
End Sub

Note that steps 1-6 are only required once since after running the EmbedGif Macro, the gif file bytes are permanently stored in the hidden worksheet and are always available to the WebBrowser ..... In fact you can even delete the embeeded gif object from the worksheet as it is not needed anymore.

 

[Jaafar Tribak]

for some reason, the workbook demo link in the previous post is not working ..... Try this one :
Workbook demo

 

[pedie]

Jaafar, thank alot. awesome....it works perfectly fine. Thanks for your help.

 

[sanjibkrjana]

The bellow code is fine for small gifs upo 700 KB f .gif file

not for a .gif fe of 1.5 MB Size. because then uond(Bytes) gives a value of moe than 1048567 ( max. no of rows in eel)

Can anybody rewrite the code for the attached gif file???

I am getting error in the line:


.Range(.Cells(1, 1), .Cells(UBound(Bytes), 1)).Value = Application.Transpose(Bytes)


this error is because .Cells(UBound(Bytes) crosses the max no of rows in excel.



Please can you give any suggestion?

Workbook example


Ok - follow these steps :

1- Manually select and copy the worksheet embeeded object(gif) to the clipboard.
2- Paste the clipboard content to the C: drive - You should now have the gif file saved to disk in the C folder.
3- Change the name of the pasted gif file to a.gif
4- add a new sheet to the workbook and name it : Gif_Bytes
5- Hide the newly added sheet - set its visible property to xlSheetVeryHidden
6- Put this code in a new standard module and run the EmbedGif Macro :

Option Explicit

Sub EmbedGif()
    Dim Bytes() As Byte
    Dim FileNum As Integer
    Dim Var() As Variant
    Const Gif_Path_Name As String = "C:\a.gif"

    FileNum = FreeFile
    
    ReDim Bytes(1 To FileLen(Gif_Path_Name))

    Open Gif_Path_Name For Binary As #FileNum
        Get #FileNum, 1, Bytes
    Close FileNum
    
        With Worksheets("Gif_Bytes")
            .Range(.Cells(1, 1), .Cells(UBound(Bytes), 1)).Value = Application.Transpose(Bytes)
        End With
        ThisWorkbook.Save
End Sub

By now you should have all the gif file bytes extracted and stored in column A in the hidden sheet.


7- Put this code in the Userform module :

Option Explicit

Private Sub UserForm_Initialize()
    CreateGifFile Environ("temp") & "\MyGif.gif"
    Me.WebBrowser1.Navigate2 Environ("temp") & "\MyGif.gif"
End Sub

Private Sub UserForm_Terminate()
    Kill Environ("temp") & "\MyGif.gif"
End Sub

Private Sub CreateGifFile(ByVal GifFile As String)
    Dim Bytes() As Byte
    Dim FileNum As Integer
    Dim Var() As Variant
    Dim x As Long
    
    Var = ThisWorkbook.Worksheets("Gif_Bytes").UsedRange.Value
     
    ReDim Bytes(LBound(Var) To UBound(Var))
    For x = LBound(Var) To UBound(Var)
        Bytes(x) = CByte(Var(x, 1))
    Next
    
    FileNum = FreeFile
    Open GifFile For Binary As #FileNum
        Put #FileNum, 1, Bytes
    Close FileNum
    
End Sub

Note that steps 1-6 are only required once since after running the EmbedGif Macro, the gif file bytes are permanently stored in the hidden worksheet and are always available to the WebBrowser ..... In fact you can even delete the embeeded gif object from the worksheet as it is not needed anymore.