学步园

Sub 新浪微博粉丝数和真粉率1()
    On Error Resume Next
    Cells.Clear
    a = Array("姓名", "粉丝", "真粉率")
    b = Array("姚晨", "李开复", "作业本", "杨幂", "刘诗诗")
    [a1:c1] = a
    [a2:a6] = Application.Transpose(b)
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "JavaScript"
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For i = 0 To UBound(b)
1:
            .Open "POST", "http://www.yeezhao.com/yeezhao/login", True
            .setRequestHeader "Referer", "http://www.yeezhao.com/apps/lens"
            .setRequestHeader "x-requested-with", "XMLHttpRequest"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .setRequestHeader "Connection", "Keep-Alive"
            .Send "random=" & Rnd() & "&nickName=" & Cells(i + 2, 1) & "&isneedtrue=1"
            .WaitForResponse
            tt = "brr=" & .responsetext
            js.AddCode tt
            ss = "a=" & js.Eval("brr.data")
            js.AddCode ss
            Cells(i + 2, 2) = js.Eval("a.followersCount")
            Cells(i + 2, 3) = js.Eval("a.trueFollowersCountRate")
            If Cells(i + 2, 3) = 0 Then GoTo 1
        Next i
    End With
End Sub

Sub 新浪微博粉丝数和真粉率2()
    On Error Resume Next
    Set oDoc = CreateObject("htmlfile")
    Cells.Clear
    [a1:g1] = Array("序号", "博客名", "博主", "点数", "粉丝", "真粉率", "ID")
    Set js = CreateObject("msscriptcontrol.scriptcontrol")
    js.Language = "JavaScript"
    With CreateObject("WinHttp.WinHttpRequest.5.1")
	    For i = 1 To 10
            .Open "GET", "http://blog.sina.com.cn/lm/iframe/top/alltop_more_new_" & i & ".html", False
            .Send
            oDoc.Body.innerHTML = StrConv(.responsebody, vbUnicode, &H804)
            Set r = oDoc.All.tags("table")(0).Rows
            For m = 1 To r.Length - 2
                For n = 0 To r(m).Cells.Length - 1
                    Cells(m + (i - 1) * 100 + 1, n + 1) = r(m).Cells(n).innerText
                Next n
            Next m
        Next i
		
        For i = 0 To 999
            If Cells(i + 2, 6) = "" Then
                .Open "POST", "http://f.yeezhao.com/rank/getSinaUserByName", False
                .setRequestHeader "x-requested-with", "XMLHttpRequest"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
                .setRequestHeader "Connection", "Keep-Alive"
                .Send "nickName=" & Cells(i + 2, 3)
                tt = Split(Split(.responsetext, """id"":""")(1), """")(0)
				
                .Open "POST", "http://f.yeezhao.com/detail/get", False
                .setRequestHeader "Referer", "http://f.yeezhao.com/detail?uid=" & tt
                .setRequestHeader "x-requested-with", "XMLHttpRequest"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
                .setRequestHeader "Connection", "Keep-Alive"
                .Send "uid=" & tt
                ss = "a=" & .responsetext
				
                js.AddCode ss
                Cells(i + 2, 5) = js.Eval("a.items.userInfo.followCount")
                Cells(i + 2, 6) = js.Eval("a.items.userInfo.rateRealFollower")
                Cells(i + 2, 7) = tt
                ss = ""
                tt = ""
            End If
        Next i
    End With
End Sub