Sub 沪深股市关注度()
    On Error Resume Next
    Cells.Clear
    Columns("A:A").NumberFormatLocal = "@"
    Cells(1, 1) = "代码"
    Cells(1, 2) = "名称"
    Cells(1, 3) = "关注该股人数（人）"
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://ddx.gubit.cn/js/stockCode.js", False
        .send
        s = BytesToBstr(.responseBody, "GB2312")
        With CreateObject("scriptcontrol")
            .Language = "jscript"
            .addcode s
            For i = 0 To .Eval("stockCodeArray.length") - 1
                w = .Eval("stockCodeArray[" & i & "][0]")
                Cells(i + 2, 1) = .Eval("stockCodeArray[" & i & "][0]")
                Cells(i + 2, 2) = .Eval("stockCodeArray[" & i & "][1]")
                With CreateObject("WinHttp.WinHttpRequest.5.1")
                    .Open "GET", "http://iguba.eastmoney.com/action.aspx?callback=a=&action=opopstock&code=" & w, False
                    .SetRequestHeader "Connection", "keep-alive"
                    .SetRequestHeader "Referer", "http://guba.eastmoney.com/list,002463.html"
                    .send
                    t = .ResponseText
                    With CreateObject("scriptcontrol")
                        .Language = "jscript"
                        .addcode t
                        Cells(i + 2, 3) = .Eval("a.data.following")
                    End With
                End With
            Next i
        End With
    End With
End Sub

Function BytesToBstr(strBody, CodeBase)
    Dim objStream
    Set objStream = CreateObject("Adodb.Stream")
    With objStream
        .Type = 1
        .Mode = 3
        .Open
        .Write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
    End With
    objStream.Close
    Set objStream = Nothing
End Function

沪深股市关注度