参考消息网友评论查询

标签：excel_vba   json   

Sub 参考消息网友评论查询()
    Cells.Clear
    [a1:g1] = Array("用户名", "用户ID", "用户ip所在地", "用户ip地址", "用户评论ID", "创建时间", "用户评论")
    Set t = CreateObject("scriptcontrol")
    t.Language = "jscript"
    Debug.Print t.Eval("new Date().getTime();")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://changyan.sohu.com/api/2/topic/comments?callback=fn&client_id=cyrlcqflH&topic_id=626430514&page_size=100000&page_no=1&style=floor&inside_floor=3&outside_floor=2&_=1434525773081", False
        .send
        t.addcode Replace(Replace(BytesToBstr(.responseBody, "UTF-8"), "(", "="), ")", "")
        For I = 0 To t.Eval("fn.comments.length") - 1
            Cells(I + 2, 1) = t.Eval("fn.comments[" & I & "].passport.nickname")    '用户名
            Cells(I + 2, 2) = t.Eval("fn.comments[" & I & "].passport.user_id")    '用户ID
            Cells(I + 2, 3) = t.Eval("fn.comments[" & I & "].ip_location")    '用户ip地址
            Cells(I + 2, 4) = t.Eval("fn.comments[" & I & "].ip")    '用户ip地址
            Cells(I + 2, 5) = t.Eval("fn.comments[" & I & "].comment_id")    '用户评论ID
            Cells(I + 2, 6) = t.Eval("new Date(" & t.Eval("fn.comments[" & I & "].create_time") & "); ")  '创建时间
            Cells(I + 2, 7) = t.Eval("fn.comments[" & I & "].content")    '用户评论
        Next I
    End With
    Cells.Columns.AutoFit
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

参考消息网友评论查询

标签：excel_vba   json   

原文地址：http://blog.csdn.net/a814153a/article/details/46534959