[發問] VBA 爬蟲 淘寶資料

kim223824

Dear 大大:

    想用VBA 爬蟲功能做一個利用"關鍵字" 可以在淘寶上搜尋賣家的資料，
    目前只能做到 在網頁上先搜尋好，再將網址貼到巨集中，爬取當下頁面的資料，
     
    請問大大，程式要如何變化以下功能
    1.將1-100頁的資料，用xlmhttp 一次抓下來，而且資料都是當下最新的
    2. 在EXCEL 中輸入"關鍵字"，直接套到淘寶的搜尋欄位。

下載 (19.26 KB)

2018-9-16 22:53

20180915_淘寶爬蟲-未完成.rar (33.03 KB)

下載次數: 6

2018-9-16 22:54

Sub 淘寶關鍵字搜尋_V1_20180915_2()

    Dim objhttp As Object

    Set objhttp = CreateObject("MSXML2.xmlhttp.3.0")
   
    Sheets("淘寶").Select
   
    myjobtype = Cells(3, "B").Value
    Tdate = Format(VBA.Date, "yyyymmdd")
    If myjobtype = "" Then
        MsgBox "請輸入搜尋關鍵字!!!!不可空白..................kim提醒。"
        Exit Sub
    End If
   
    Application.ScreenUpdating = False      '畫面更新關閉
    URL = "https://s.taobao.com/search?q=%E5%AF%B5%E7%89%A9&type=p&tmhkh5=&spm=a21wu.241046-tw.a2227oh.d100&from=sea_1_searchbutton&catId=100"
   
    objhttp.Open "GET", URL, 1
    objhttp.send

    While objhttp.readyState <> 4: DoEvents: Wend

    Sheets("下載").Select
   
    ROW3 = Cells(Rows.Count, 1).End(3).Row
    Range(Cells(1, 1), Cells(ROW3, 3)).Clear
   
    Cells(1, 1) = objhttp.responseText
    S = objhttp.responseText

    iStart = 1
    i = 2
   
    Do While VBA.InStr(iStart, S, "item_loc") <> 0
        
        iStart = VBA.InStr(iStart, S, "raw_title")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "A") = Mid(S, iStart + 12, iEnd - iStart - 13)
        iStart = iEnd + 12
   
   
        iStart = VBA.InStr(iStart, S, "item_loc")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "B") = Mid(S, iStart + 11, iEnd - iStart - 12)
        iStart = iEnd + 11
        
        iStart = VBA.InStr(iStart, S, "nick")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "C") = Mid(S, iStart + 7, iEnd - iStart - 8)
        iStart = iEnd + 7
        
        i = i + 1
   
    Loop

      

End Sub