user429400 user429400 - 1 year ago 104
reST (reStructuredText) Question

Get picture as http GET response and insert to spreadsheet without saving the picture

I'm using the following code to get a picture from the bing map website and insert it to the spreadsheet:

Public Sub Test()
Dim FileNum As Long
Dim myURL As String
Dim FileData() As Byte
Dim winHttpReq As Object
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

myURL = "..."

winHttpReq.Open "GET", myURL, False

FileData = winHttpReq.ResponseBody

FileNum = FreeFile
Open "C:\Downloads\map.JPG" For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum

End Sub

Sub InsertPic()
Dim pic As String
Dim myPicture As Picture

pic = "C:\Downloads\map.JPG"
Set myPicture = ActiveSheet.Pictures.Insert(pic)

With myPicture
.ShapeRange.LockAspectRatio = msoFalse
.Top = ActiveSheet.Cells(33, 10).Top
.Left = ActiveSheet.Cells(33, 10).Left
End With
End Sub

Is there a way to do the same without saving the picture on the local storage?

Answer Source

I'm just saying that since I don't actually need to store the file I prefer not to, unless I have to.

I hate to give up! Though I still feel (as I mentioned in my comments above) that saving the file to user's temp directory is a simple and easy way to go about it. In fact I will mention both the methods for you.

To test this example, create a userform in Excel. Next, do this.

  1. Place a TextBox, Image and a Commandbutton control in it.
  2. next add the inet control. For this you will have to go via additional controls and set a reference to Microsoft Internet Transfer Control Your userform will look like this.

enter image description here

Next run the userform and then paste the URL of the image in the textbox. I am testing it with

When you click on the commandbutton, the image will populate in the image control.

enter image description here


What the code does is uses the inet control to retrieve the image in the URL and then store it in a byte array (instead of a directory as you requested). I then take that byte array and convert that into an image inmemory and then assign it to the image control.

Userform Code

Option Explicit

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" _
(ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long

Private Declare Function OleLoadPicture Lib "olepro32.dll" _
(ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" _
(ByVal lpsz As Long, ByRef pclsid As GUID) As Long

Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Dim boolSuccess As Boolean

Private Sub CommandButton1_Click()
    Dim URL As String
    Dim bytes() As Byte
    Dim ipic As IPictureDisp

    URL = TextBox1.Text

    '~~> Store the image from the url in a bytes array
    bytes() = Inet1.OpenURL(URL, icByteArray)

    '~~> Convert Byte Array into Image
    Set ipic = ImageFromByteAr(bytes)

    Image1.PictureSizeMode = fmPictureSizeModeStretch

    If boolSuccess = True Then
        '~~> Load Picture
        Image1.Picture = ipic
        MsgBox "Unable to convert to picture"
    End If
End Sub

Public Function ImageFromByteAr(ByRef byt() As Byte) As IPicture
    On Error GoTo Whoa

    Dim ippstr As IUnknown
    Dim tGuid As GUID

    If Not CreateStreamOnHGlobal(byt(LBound(byt)), False, ippstr) Then
        CLSIDFromString StrPtr(SIPICTURE), tGuid
        OleLoadPicture ippstr, UBound(byt) - LBound(byt) + 1, False, tGuid, ImageFromByteAr
    End If

    Set ippstr = Nothing

    boolSuccess = True
    Exit Function
    boolSuccess = False
End Function

And this is METHOD 2 (The simplest way)

Saving the file to user's temp directory

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Public Sub Test()
    '~~> Rest of your code

    FileNum = FreeFile
    Open TempPath & "\map.JPG" For Binary Access Write As #FileNum

    '~~> Rest of your code
End Sub

Sub InsertPic()
    '~~> Rest of your code

    Dim pic As String
    Dim myPicture As Picture

    pic = TempPath & "\map.JPG"
    Set myPicture = ActiveSheet.Pictures.Insert(pic)

    '~~> Rest of your code
End Sub
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download