vba爬取生意参谋数据，原来是可以的，现在不行了，请懂的大佬给分析分析，修改下代码

专搞excel

Sub 生意参谋()

    WebBrowser.Show
    WebBrowser.Height = 600
    WebBrowser.Width = 950

    Set ie1 = WebBrowser.WebBrowser1

    '登录
    With ie1
        .Silent = True

        .Navigate "https://sycm.taobao.com/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 = "https://sycm.taobao.com/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

duquancai

淘宝登陆，想干什么？         用户名，密码都没有，咋登陆？怎么分析？

专搞excel

这个咋办，这是登录的淘宝店铺的生意参谋，账号和密码不方便说啊

caodaoquan

若需到淘宝搜"小虎办公"，联系解决。

专搞excel

caodaoquan 发表于 2018-9-15 18:45
若需到淘宝搜"小虎办公"，联系解决。

淘宝搜索不到啊，这个是什么东西