获取图片作为http GET响应并插入电子表格而不保存图片

我使用以下代码从bing地图网站获取图片并将其插入电子表格：

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 winHttpReq.Send FileData = winHttpReq.ResponseBody FileNum = FreeFile Open "C:\Downloads\map.JPG" For Binary Access Write As #FileNum Put #FileNum, 1, FileData Close #FileNum InsertPic 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 

有没有办法做到这一点，而不保存在本地存储图片？

Answer 1

我只是说，因为我实际上并不需要存储我不喜欢的文件，除非必须。

我讨厌放弃！ 虽然我仍然觉得（ 正如我在上面的评论中提到的那样 ）将文件保存到用户的临时目录是一种简单而简单的方法。 事实上，我会提到你的两种方法。

为了testing这个例子，在Excel中创build一个用户表单。 接下来，做到这一点。

1. 在其中放置一个TextBox，Image和一个Commandbutton控件。
2. 接下来添加inet控件。 为此，您将不得不通过其他控件并设置对Microsoft Internet Transfer Control的引用您的用户窗体将如下所示。

接下来运行用户窗体，然后将该图像的URL粘贴到文本框中。 我正在testing它与http://static.freepik.com/free-photo/thumbs-up-smiley_17-1218174614.jpg

当你点击命令button时，图像将填充到图像控件中。

逻辑 ：

代码所做的是使用inet控件来检索URL中的图像，然后将其存储在byte数组（ 而不是您请求的目录 ）中。 然后我把这个字节数组转换成一个内存中的图像，然后将其分配给图像控件。

用户表单代码

 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 Else 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 Whoa: boolSuccess = False End Function 

---

这是方法2 （最简单的方法）

将文件保存到用户的临时目录

 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 

Answer 2

如果你有这个URL，那么：

 Sub PictureGrabber() With ActiveSheet.Pictures .Insert ("http://www.cnn.com/whatever.jpg") End With End Sub 

编辑＃1 ：

对于使用winHttpReq的一些示例编码，请查看这里的第一个函数

Answer 3

如果，WRT SiddharthRout的解决scheme，你想与64位Office的兼容性，那么改变声明：

 #If VBA7 Then Private Declare PtrSafe Function CreateStreamOnHGlobal Lib "OLE32.DLL" (ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long Private Declare PtrSafe Function OleLoadPicture Lib "oleaut32.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 PtrSafe Function CLSIDFromString Lib "OLE32.DLL" (ByVal lpsz As LongPtr, ByRef pclsid As GUID) As Long #Else 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 #End If 

感谢Hans Passant。