如何提取淘宝商品的数据？谢谢

cumulonimbus

我在淘宝上搜索了一大堆杏仁http://s.taobao.com/search?q=%D0%D3%C8%CA&initiative_id=staobaoz_20130207，呵呵，不知道买哪个好，排价格后发现它的价格排列不是以500克为标准的排列的，烦啦
我想提取它们的货名、每500克多少元、净含量、物流运费、30天售出件数、评价等信息，打开它的源文件却找不到，必须把这些货品一个个点开才能找到信息，请问可有办法？谢谢

蓝天630902

Sub 杏仁_淘宝搜索()
    On Error Resume Next
    Dim searchname As String
    Set oDoc = CreateObject("htmlfile")
    Columns("A:A").NumberFormatLocal = "@"
    searchname = "杏仁"    '%D0%D3%C8%CA
    qst = encodeURI(searchname)
    riqi = Format(Now, "yyyymmdd")
    [a1:f1] = Split("货名、每半斤多少元、净含量、物流运费、最近成交、评价等信息", "、")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For p = 1 To 100
            n = Range("a65536").End(xlUp).Row
            .Open "POST", "http://s.taobao.com/search?q=" & qst & "&initiative_id=tbindexz_" & riqi & "&commend=all&ssid=s5-e&search_type=item&sourceId=tb.index&bcoffset=1&newpre=null&s=" & (p - 1) * 40, False
            .SetRequestHeader "Referer", "http://www.taobao.com/"
            .SetRequestHeader "Connection", "Keep-Alive"
            .send
            tt = Split(Split(.responsetext, "data-item-count=""40"">")(1), "<!-- end list view -->")(0)
            oDoc.body.innerHTML = tt
            Set r = oDoc.All.tags("li")
            m = 0
            For i = 0 To r.Length - 1
                If r(i).classname = "list-item" Then
                    m = m + 1
                    't1 = Split(r(i).All.tags("a")(0).Title, "杏仁")
                    Cells(n + m, 1) = r(i).All.tags("a")(0).Title    '货名
                    Cells(n + m, 2) = r(i).All.tags("em")(1).innerText & "元/" & r(i).All.tags("em")(2).innerText    '每半斤多少元
                    'Cells(n + m, 3) = t1(UBound(t1))    '净含量
                    Cells(n + m, 4) = Split(r(i).All.tags("li")(1).innerText, "：")(1)    '物流运费
                    Cells(n + m, 5) = Split(r(i).All.tags("li")(0).innerText, "最近成交")(1)   '最近成交
                    Cells(n + m, 6) = "http://rate.tmall.com/list_detail_rate.htm?itemId=" & Split(r(i).All.tags("a")(0).href, "id=")(1) & "&currentPage=1"    '评价等信息
                End If
            Next i
        Next p
    End With
End Sub

Function encodeURI(becoded As String) As String    'url编码
    Set JS = CreateObject("msscriptcontrol.scriptcontrol")
    JS.Language = "JavaScript"
    encodeURI = JS.Eval("encodeURIComponent('" & becoded & "');")
End Function

cumulonimbus

蓝天大师，非常感谢您的帮助。下面几句我没弄清楚，能否答疑解惑，谢谢
.Open "POST", "http://s.taobao.com/search?q=" & qst & "&initiative_id=tbindexz_" & riqi & "&commend=all&ssid=s5-e&search_type=item&sourceId=tb.index&bcoffset=1&newpre=null&s=" & (p - 1) * 40, False
  .SetRequestHeader "Referer", "http://www.taobao.com/"
  .SetRequestHeader "Connection", "Keep-Alive"
你不是在第一句连上淘宝的搜索网页了吗，为什么还要在第二句中再次连上淘宝主页？第三句，我完全没弄懂啥意思？

cumulonimbus

蓝天630902 发表于 2013-2-6 11:17
Sub 杏仁_淘宝搜索()
    On Error Resume Next
    Dim searchname As String

蓝天大师，非常感谢您的帮助。下面几句我没弄清楚，能否答疑解惑，谢谢
.Open "POST", "http://s.taobao.com/search?q=" & qst & "&initiative_id=tbindexz_" & riqi & "&commend=all&ssid=s5-e&search_type=item&sourceId=tb.index&bcoffset=1&newpre=null&s=" & (p - 1) * 40, False
  .SetRequestHeader "Referer", "http://www.taobao.com/"
  .SetRequestHeader "Connection", "Keep-Alive"
你不是在第一句连上淘宝的搜索网页了吗，为什么还要在第二句中再次连上淘宝主页？第三句，我完全没弄懂啥意思？

cumulonimbus

蓝天630902 发表于 2013-2-6 11:17
Sub 杏仁_淘宝搜索()
    On Error Resume Next
    Dim searchname As String

蓝天大师，新年好呀！
这个地方没想明白，这个标签内容你是如何弄出来的，谢谢
本想加入其它内容：如插入其商品图片，写入商品网站链接，不知从何加起？
  Cells(n + m, 1) = r(i).All.tags("a")(0).Title    '货名
                    Cells(n + m, 2) = r(i).All.tags("em")(1).innerText & "元/" & r(i).All.tags("em")(2).innerText    '每半斤多少元
                    'Cells(n + m, 3) = t1(UBound(t1))    '净含量
                    Cells(n + m, 4) = Split(r(i).All.tags("li")(1).innerText, "：")(1)    '物流运费
                    Cells(n + m, 5) = Split(r(i).All.tags("li")(0).innerText, "最近成交")(1)   '最近成交

小zhi

留个脚印！！！！！

鑫尼达

留个脚印！！！！！