我想通过Excel VBA从此主页下载图片。
我可以获得HTMLCamvasElement但我无法将图片下载到我的本地文件夹。
请让我知道如何下载这些图片。
这是我的代码..
============================
Sub test_fill_form()
Dim url1 As String
url1 = "http://www.guitarcenter.com/Gibson-Custom-Alex-Lifeson-Les-Paul-Axcess-Electric-Guitar-106521313-i1797778.gc"
Dim oIE 'As InternetExplorer
Dim oDoc 'As HTMLDocument
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
oIE.navigate url1
'wait
While oIE.readyState <> 4: DoEvents: Wend
Set oDoc = oIE.document
'wait
While oIE.readyState <> 4: DoEvents: Wend
'--------------------------
Dim oDivElem 'As HTMLDivElement
Dim oCanElem 'As HTMLCanvasElement
Set oDivElem = oDoc.getElementById("s7zoomView1")
Set oCanElem = oDivElem3.getElementsByTagName("CANVAS")(1)
Stop
'I want to download a image file from oCanElem...
'Do I need to use method of 'toData' ??
End Sub
答案 0 :(得分:0)
正如从画布中将png图像保存到文件的示例:
Sub test_toDataURL()
' Tools - References - Add ref to:
' Microsoft Internet Controls
' Microsoft HTML Object Library
' Microsoft ActveX Data Objects 6.1 Library
' Microsoft XML, v3.0
Dim objIE As SHDocVw.InternetExplorer 'InternetExplorer
Dim objDoc As MSHTML.DOMDocumentType 'As HTMLDocument
Dim objCanvas 'As MSHTML.HTMLCanvasElement 'As HTMLCanvasElement
Dim objXML As MSXML2.DOMDocument
Dim objDocElem As MSXML2.IXMLDOMElement
Dim objStream As ADODB.Stream
Dim strImg, strData, strPath
Dim arr64decode() As Byte
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.Navigate "http://earth.nullschool.net/"
Do While objIE.readyState <> 4
DoEvents
Loop
Set objDoc = objIE.document
objDoc.parentWindow.execScript "alert('Testing what we have:\n\n'+document.getElementsByTagName('CANVAS')(0).toDataURL('image/png'));", "javascript"
Application.Wait (Now + TimeValue("0:00:10")) ' waiting for drawing starts
Set objCanvas = objDoc.getElementsByTagName("CANVAS")(0)
strImg = objCanvas.toDataURL("image/png")
If Left(strImg, 22) <> "data:image/png;base64," Then
strImg = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAsAAAASCAIAAAACF7MiAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAABpSURBVChTYzxw4AADfgBU8R83AMoyQRXiBqSquDPRmpExfTuUBwHk2GKlpQplQQCpZqio6UBZCIBpho6aCpQFASS7VFXLCsqCAzQVKvlHZ3pC2VCAqoJwiAGN+P8fzRCSXYoFEEpBDAwAPNYyBnTMkl4AAAAASUVORK5CYII="
End If
strData = Right(strImg, Len(strImg) - 22)
Set objXML = New MSXML2.DOMDocument
Set objDocElem = objXML.createElement("tmp")
objDocElem.DataType = "bin.base64"
objDocElem.Text = strData
arr64decode = objDocElem.NodeTypedValue
Set objStream = New ADODB.Stream
objStream.Type = adTypeBinary ' Const adTypeBinary = 1
objStream.Open
objStream.Write arr64decode
strPath = ThisWorkbook.path & "\picture.png"
objStream.SaveToFile strPath, adSaveCreateOverWrite ' Const adSaveCreateOverWrite = 2
objIE.Quit
MsgBox "Saved to " & strPath
End Sub
我想要注意的是,相同的代码在VBScript中运行良好,只需实现后期绑定和其他一些小的更改,因此您可能根本不使用MS Office。