2014-04-19 126 views
0

我想通过Excel VBA从此主页下载图片。如何从HTMLCanvasElement下载图片?

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

我可以得到一个HTMLCamvasElement,但我无法下载图片到我的本地文件夹。

请让我知道如何下载这些图片。

这里是我的代码..

============================

子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' ?? 

结束子

+0

请提供任何编码试图 – xlembouras

+0

酷吉他的兄弟 –

+0

不幸的是提供[链接](http://www.guitarcenter.com/Gibson-Custom-Alex-Lifeson-Les-Paul-Axcess-Electric-Guitar-106521313-i1797778 .gc)给**的产品,你正在寻找的是在这个时间售罄**。 – omegastripes

回答

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。