Sub 生意参谋()
WebBrowser.Show
WebBrowser.Height = 600
WebBrowser.Width = 950
Set ie1 = WebBrowser.WebBrowser1
'登录
With ie1
.Silent = True
.Navigate "/mq/words/search_words.htm"
Do Until .readystate = 4
DoEvents
Loop
cu = ie1.locationurl
Do Until InStr(cu, "/login.") = 0
DoEvents
If WebBrowser.Visible = False Then
Application.EnableEvents = True
End
End If
cu = ie1.locationurl
Loop
strText = .document.DocumentElement.outerhtml
token = Split(Split(strText, "legalityToken=")(1), ";")(0)
End With
Set ie1 = Nothing
WebBrowser.Hide
'下载数据
'日期
day1 = Format(Date - 7, "yyyy-mm-dd")
day2 = Format(Date - 1, "yyyy-mm-dd")
cg_UTF8 = encodeURI("红茶") '转换编码
Url = "/mq/searchword/relatedWord.json?dateRange=" & day1 & "%7C" & day2 & "&dateType=recent7&device=0&keyword=" & cg_UTF8 & "&token=" & token
With CreateObject("Msxml2.XMLHTTP.6.0") 'CreateObject("Msxml2.XMLHTTP") CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", Url, False
.send '发送请求
strText = .responseText '返回请求
If InStr(strText, "charset=""gb") Or InStr(strText, "charset=gb") Then strText = StrConv(.responseBody, vbUnicode)
Debug.Print strText
End With
End Sub
'转成UTF-8
Function encodeURI(strText As String) As String
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
encodeURI = .Eval("encodeURIComponent('" & strText & "');")
End With
End Function
python 爬取生意参谋数据_Excel vba爬取生意参谋数据 原来是可以的 现在不行了 请懂的大佬给分析分析 修改下代码-ExcelVBA程序开发-ExcelHome技术论坛 -...
