如何从HTMLCanvasElement下载图片?

时间:2014-04-19 09:25:45

标签: html vb.net vba canvas

我想通过Excel VBA从此主页下载图片。

实施例。 http://www.guitarcenter.com/Gibson-Custom-Alex-Lifeson-Les-Paul-Axcess-Electric-Guitar-106521313-i1797778.gc

我可以获得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

1 个答案:

答案 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。