|
- Sub Test()
- Dim url As String, winhttp As Object, data As String, objJSON As Object, k As Long
- Dim arr(1 To 48000, 1 To 6), js As Object, jsjosn As Object, ss As Object, Page As Integer
- url = "http://zxq.zxtom2.com/3341470/zxqlist!list.jsp"
- Set winhttp = CreateObject("winhttp.winhttprequest.5.1")
- Set js = CreateObject("scriptcontrol")
- js.Language = "jscript"
- For Page = 1 To 50
- data = "pageNum=" & Page & "&areaCode=0&companyId=0&orderTemp=0&from=&"
- With winhttp
- .Open "POST", url, False
- .setrequestheader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
- .setrequestheader "Referer", "http://zxq.zxtom2.com/3341470/zxqlist.jsp"
- .setrequestheader "Host", "zxq.zxtom2.com"
- .send data
- DoEvents
- js.addcode "var mydata=" & .responsetext
- Set objJSON = js.CodeObject
- For Each ss In CallByName(objJSON.mydata, "Tlist", VbGet)
- If CallByName(ss, "cityName", VbGet) = "上海市" And CallByName(ss, "companyName", VbGet) = "无限极" And CallByName(ss, "strengthindex", VbGet) > 0 Then
- k = k + 1
- arr(k, 1) = CallByName(ss, "name", VbGet)
- arr(k, 2) = CallByName(ss, "phone", VbGet)
- arr(k, 3) = "'" & CallByName(ss, "wechatNumber", VbGet)
- arr(k, 4) = CallByName(ss, "cityName", VbGet)
- arr(k, 5) = CallByName(ss, "companyName", VbGet)
- arr(k, 6) = "'" & CallByName(ss, "strengthindex", VbGet)
- End If
- Next
- Set objJSON = Nothing
- Set ss = Nothing
- DoEvents
- Application.StatusBar = "正在获取 第 " & Page & "页 数据中"
- End With
- Next
- If k > 0 Then
- Range("A2").Resize(k, 6) = arr
- MsgBox "获取成功"
- Else
- MsgBox "没有获取到数据"
- End If
- End Sub
复制代码
试试 |
评分
-
2
查看全部评分
-
|