Dear 大大:
想用VBA 爬蟲功能做一個利用"關鍵字" 可以在淘寶上搜尋賣家的資料，
目前只能做到 在網頁上先搜尋好，再將網址貼到巨集中，爬取當下頁面的資料，
請問大大，程式要如何變化以下功能
1.將1-100頁的資料，用xlmhttp 一次抓下來，而且資料都是當下最新的
2. 在EXCEL 中輸入"關鍵字"，直接套到淘寶的搜尋欄位。
 20180915_淘寶爬蟲-未完成.rar (33.03 KB)
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 |
發表於 2018-9-16 22:55
| 
