高考成绩批量查询

zenglq936

学校要求查询出考生高考成绩，请高手帮忙。查询网址和基础数据在附件中

cwpccna

     呵呵,这个是有跨域, 异步请求,有点还要带上Referer 头,  希望VBA的同学注意下,  finddler 抓包如下
GET http://api.sceea.cn/Handler/GetS ... 9%E5%87%BB&_=12 HTTP/1.1
Host: api.sceea.cn
Connection: keep-alive
Upgrade-Insecure-Requests: 1
User-Agent: Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/67.0.3396.87 Safari/537.36
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8
Accept-Encoding: gzip, deflate
Accept-Language: zh-CN,zh;q=0.9
Cookie: UM_distinctid=16454cca0a11cb-0786063d79f98e-5b183a13-1fa400-16454cca0a32bb; cookiesession1=34339556CR9DEPKEFCTDGBXVYKSDBEF7; ASP.NET_SessionId=vfqopdz52tlur3biulsawdpu
Referer: www.baidu.com


返回值如下:

1. HTTP/1.1 200 OK
   
2. Server: nginx
   
3. Date: Sun, 01 Jul 2018 08:05:23 GMT
   
4. Content-Type: text/plain; charset=utf-8
   
5. Content-Length: 804
   
6. Connection: keep-alive
   
7. Cache-Control: private
   
8. X-AspNet-Version: 4.0.30319
   
9. X-Powered-By: ASP.NET
   
10. X-Frame-Options: SAMEORIGIN
    
11. 
    
12. jQuery160837371150395742_1530432772937({"ResultCode":"00","ResultMsg":"查询成功","QueryKey":"18511002160255","QResults":[{"Code":"XM","Name":"姓　　名","QValue":"肖淙元                  "},{"Code":"KSH","Name":"考生号","QValue":"18511002160255"},{"Code":"ZKZH","Name":"准考证号","QValue":"100290719"},{"Code":"YW","Name":"语　　文","QValue":"84"},{"Code":"SX","Name":"数　　学","QValue":"95"},{"Code":"WY","Name":"外　　语","QValue":"97"},{"Code":"ZH","Name":"理科综合","QValue":"128"},{"Code":"ZZ_WL","Name":"物　　理","QValue":"29.0"},{"Code":"LS_HX","Name":"化　　学","QValue":"44.5"},{"Code":"DL_SW","Name":"生　　物","QValue":"54.5"},{"Code":"ZF","Name":"总　　分","QValue":"404"},{"Code":"CXSJ","Name":"查询时间","QValue":"2018-07-01 16:29"}]})

复制代码

cwpccna

这么少的数量,为啥不,粘贴复制啊!

cwpccna

  高考成绩不是学生自己差的吗?  楼主是不是在做犯罪的事情?

zenglq936

学校要求的

mxf21cn

Public Sub 四川省高考成绩查询()
      
      Dim strURL As String
      Dim strData As String
      Dim xmlHttp As Object
      
      Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
      
      For i = 2 To 20
         
         k1 = Cells(i, 1)    '考生号
        k2 = Cells(i, 2)    '准考证号
        k3 = Cells(i, 3)    '身份证号
     
         strURL = "http://wx.scedu.net/server/scedu_cj_ajax.ashx?action=GetJsResult&ksh=" & k1 & "&zkzh=" & k2 & "&sfzh=" & k3 & "&_=1530541150633"
      
         With xmlHttp
              .Open "GET", strURL, False
             .send
         
             Do While .readystate <> 4
                  DoEvents
             Loop
         
             k = Split(.ResponseText, "th%3E%3Ctd%3E")(10)
             Cells(i, 5) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(4), "%3C")(0)
             Cells(i, 6) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(5), "%3C")(0)
             Cells(i, 7) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(6), "%3C")(0)
             Cells(i, 8) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(7), "%3C")(0)
             Cells(i, 9) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(12), "%3C")(0)
         
         End With
      
      Next

End Sub

zenglq936

mxf21cn 发表于 2018-7-13 20:50
Public Sub 四川省高考成绩查询()
      
      Dim strURL As String

运行时出现：“下届超标”请问如何处理？

mxf21cn

zenglq936 发表于 2018-7-24 16:34
运行时出现：“下届超标”请问如何处理？

我这里测试好像没有问题，
你把你的附件传上来，我来看看问题在哪里

mxf21cn

zenglq936 发表于 2018-7-24 16:34
运行时出现：“下届超标”请问如何处理？

应该是你到附件和我原来用的表格格式有不一样的地方，我再改改

mxf21cn

Public Sub 四川高考成绩查询()
      
       Dim strURL As String
       Dim strData As String
       Dim xmlHttp As Object
      
       Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
      
       For i = 2 To 20
         
          k1 = Cells(i, 1)    '考生号
        k2 = Cells(i, 3)    '准考证号
        k3 = Cells(i, 2)    '身份证号
     
          strURL = "http://wx.scedu.net/server/scedu_cj_ajax.ashx?action=GetJsResult&ksh=" & k1 & "&zkzh=" & k2 & "&sfzh=" & k3 & "&_=1530541150633"
      
          With xmlHttp
               .Open "GET", strURL, False
              .send
           
              Do While .ReadyState <> 4
                   DoEvents
              Loop
              
              'Debug.Print .ResponseText
           
              k = Split(.ResponseText, "th%3E%3Ctd%3E")(10)
              Cells(i, 5) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(4), "%3C")(0)
              Cells(i, 6) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(5), "%3C")(0)
              Cells(i, 7) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(6), "%3C")(0)
              Cells(i, 8) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(7), "%3C")(0)
              Cells(i, 9) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(8), "%3C")(0)
              Cells(i, 10) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(9), "%3C")(0)
              Cells(i, 11) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(10), "%3C")(0)
              Cells(i, 12) = Split(Split(.ResponseText, "th%3E%3Ctd%3E")(12), "%3C")(0)
         
          End With
      
       Next

End Sub
这个应该没问题了