全国人民法院失信被执行人名单信息公布与查询

全国法院失信被执行人名单信息公布与查询

 

数据地址：http://shixin.court.gov.cn/personMore.do

 

 

Sub 全国法院失信被执行人名单信息公布与查询()
    Cells.Clear
    On Error Resume Next
    Dim hf, arr(1 To 15, 1 To 17), brr, js
    brr = Array("iname", "sexy", "age", "cardNum", "courtName", "areaName", "gistId", "regDate", "caseCode", "gistUnit", "duty", "performance", "disruptTypeName", "publishDate", "focusNumber")
    [A1:Q1] = Array("序号", "失信被执行人姓名/名称", "被执行人姓名/名称", "性别", "年龄", "身份证号码/组织机构代码", "执行法院", "省份", "执行依据文号", "立案时间", "案号", "做出执行依据单位", "生效法律文书确定的义务", "被执行人的履行情况", "失信被执行人行为具体情形", "发布时间", "关注次数")
    Set js = CreateObject("MSScriptControl.ScriptControl")
    js.Language = "jscript"
    Set hf = CreateObject("htmlfile")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For p = 1 To 100000
            n = (p - 1) * 15 + 2
            .Open "GET", "http://shixin.court.gov.cn/personMore.do?currentPage=" & p, False
            .send
            q = Split(Split(.responsetext, "gotoPage(")(2), ")")(0)
            hf.body.innerhtml = .responsetext
            Set r = hf.getelementbyid("Resultlist").Rows
            For i = 1 To r.Length - 1
                arr(i, 1) = n + i - 2
                arr(i, 2) = r(i).Cells(1).innertext
                .Open "GET", "http://shixin.court.gov.cn/detail?id=" & r(i).all.tags("a")(1).ID, False
                .send
                js.AddCode "a=" & .responsetext
                For j = 1 To UBound(brr)
                    arr(i, j + 2) = Replace(js.Eval("a." & brr(j)), vbLf, "")
                Next j
            Next i
            Range("a" & n).Resize(15, 17) = arr
            If Val(q) = p Then Exit For
        Next p
    End With
End Sub