2014-04-19 125 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。