Retrieve images embedded in Excel file - sql

Question

I'm currently in the process of upscaling an Excel solution to a web solution. In this process, I need to upload the existing data into the new (SQL Server) database.
Problem is, that I also need to upload the images that are stored in the Excel file (as shapes). In the database, they will be stored as bytearray in PNG format.
What is the best way to retrieve the source of any embedded image?
I'm currently thinking of either using ws.Shapes("img_1").CopyPicture and some API functions to retrieve it - but so far, got stuck in figuring out the proper API functions. Also, not sure if there isn't an easier/more elegant way...

Answer 1

If you don't mind getting all images as files in your disk and afterwards uploading those to your database, you could just save the Excel workbook or worksheet as "Web Page".
That will create a html file and a directory filled with whatever images (one PNG file per image) the original Excel file has.

Answer 2

Okay, finally found a solution. Not sure this is the most elegant version - and right now it requires IrfanView or another converter - but it does the job. Can be called with fctStrConvertImageToString(Sheets("YourSheet").Shapes("YorImage")) and will return the PBG of this image as string:
Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(8) As Byte
End Type
Private Type PICTDESC
cbSize As Long
picType As Long
hImage As Long
End Type
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 SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long
Public Function fctStrConvertImageToString(shp As Shape) As String
Const cStrPath As String = "C:\Temp\"
Const cStrFileName As String = "temp"
Const cStrSourceExtension As String = "bmp"
Const cStrTargetExtension As String = "png"
Dim strSource As String, strTarget As String
If shp.Type <> msoPicture Then Exit Function
shp.CopyPicture 1, xlBitmap
strSource = cStrPath & cStrFileName & "." & cStrSourceExtension
strTarget = cStrPath & cStrFileName & "." & cStrTargetExtension
subSavePicAsBitmap strSource
subConvertFile strSource, strTarget
fctStrConvertImageToString = fctStrReadFile(strTarget)
Kill strSource
Kill strTarget
End Function
Private Sub subSavePicAsBitmap(strFile As String)
Const cStrPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Dim hCopy&: OpenClipboard 0&
Dim iPic As IPicture
Dim tIID As GUID
Dim tPICTDEST As PICTDESC
Dim lngReturn As Long
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy = 0 Then Exit Sub
lngReturn = IIDFromString(StrConv(cStrPictureIID, vbUnicode), tIID)
If lngReturn Then Exit Sub
With tPICTDEST
.cbSize = Len(tPICTDEST)
.picType = 1
.hImage = hCopy
End With
lngReturn = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)
SavePicture iPic, strFile
End Sub
Private Sub subConvertFile(strSource As String, strTarget As String)
Const cStrConverter = """c:\Program Files (x86)\IrfanView\i_view32.exe"""
Shell cStrConverter & " " & strSource & " /convert=" & strTarget, 0
End Sub
Private Function fctStrReadFile(strFile As String)
Dim hFile As Long
hFile = FreeFile
Open strFile For Binary Access Read As #hFile
fctStrReadFile = Input$(LOF(hFile), hFile)
Close #hFile
End Function