|
|
楼主 |
发表于 2018-11-15 17:49
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub test(Target As Range)
Dim oXML As Object, oJS As Object
Dim oWindow As Object, oDom As Object, obj As Object
Dim sUrl$, sRes$, sPUrl$
Dim price$, id$
Dim sPicUrl1$, sPicurl2$, fp$
Dim picData() As Byte
Dim temp1$, temp2$
Dim shopName$, proName$
sUrl = Target
id = Mid(Target, InStrRev(sUrl, "/") + 1)
id = Left(id, Len(id) - 5)
Set oXML = CreateObject("msxml2.xmlhttp")
Set oJS = CreateObject("Msscriptcontrol.scriptcontrol")
Set oDom = CreateObject("htmlfile")
Set oWindow = oDom.parentWindow
With oXML
.Open "GET", "http://www.w3school.com.cn/jquery/jquery.js", False
.SEND
End With
With oXML
.Open "GET", sUrl, False
.SEND
oDom.Write "<script src ='http://www.w3school.com.cn/jquery/jquery.js'></script><body></body>"
sRes = .responsetext
oDom.body.innerHTML = sRes
End With
shopName = oWindow.eval("$('a[clstag*=""dianpuname2""]').text()")
proName = oWindow.eval("$('div.sku-name').text()")
Cells(Target.Row, "h") = proName
Cells(Target.Row, "h").WrapText = True
Cells(Target.Row, "j") = Mid(shopName, 4)
Cells(Target.Row, "j") = shopName
sPicUrl1 = "http:" & oWindow.eval("$('#spec-img').attr('data-origin')")
sPicurl2 = oWindow.eval("$('li.img-hover').children('img').attr('src')")
sPicurl2 = "http" & Mid(sPicurl2, 6)
With oXML
.Open "GET", sPicUrl1, False
.SEND
picData = .ResponseBody
fp = ThisWorkbook.Path & "\temp1.jpg"
Open fp For Binary Access Write As #1
Put #1, 1, picData
Close #1
End With
With oXML
.Open "GET", sPicurl2, False
.SEND
picData = .ResponseBody
fp = ThisWorkbook.Path & "\temp2.jpg"
Open fp For Binary Access Write As #1
Put #1, 1, picData
Close #1
End With
With oXML
sPUrl = "https://p.3.cn/prices/mgets?skuIds=J_" & id
.Open "GET", sPUrl, False
.SEND
Debug.Print sPUrl
Debug.Print .responsetext
oWindow.execScript ("js=" & .responsetext)
price = oWindow.eval("js[0].p")
Cells(Target.Row, "i") = price
End With
insertPicture Cells(Target.Row, "f"), ThisWorkbook.Path & "\temp1.jpg"
insertPicture Cells(Target.Row, "g"), ThisWorkbook.Path & "\temp2.jpg"
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-11-15 17:32
