解析网页源码，获得所需数据。

学不完用不尽

赞一个，值得学习。

whmwhm

看来要学习的东西太多了。选收藏，每周弄会一个，就满足了。

dl0506

Kaohsing 发表于 2017-11-14 10:47
文接上楼
  公告大全部分代码（为了避免或许麻烦，只贴截图）

Kaohsing老师，问一下这两个什么区别啊？
createobject("msxml2.xmlhttp")和CreateObject("WinHttp.WinHttpRequest.5.1")

Kaohsing

dl0506 发表于 2018-3-22 16:51
Kaohsing老师，问一下这两个什么区别啊？
createobject("msxml2.xmlhttp")和CreateObject("WinHttp.WinH ...

后者不读取缓存，可以模拟重定向。

地天泰

老师厉害了。我要多读几遍，看看能否弄明白。

Kaohsing

地天泰 发表于 2018-3-29 21:36
老师厉害了。我要多读几遍，看看能否弄明白。

多读几遍，其义自见。

Kaohsing

记录一下：
Sub kao_js()
    Application.ScreenUpdating = False
    Dim html As Object, js As Object
    Dim strText$, I%
    Set html = CreateObject("msxml2.xmlhttp")
    Range("a1").Resize(1, 10) = Split("法院 法庭 开庭日期 排期日期 案号 案由 承办部门 审判长/主审人 公诉人/原告/上诉人/申请人 被告/被告人/被上诉人/被申请人")
   
    For I = 1 To InputBox("数据大约有12k条，下载较慢，页数范围在1-23", "获得查询的页数", 10)
        html.Open "POST", "http://www.zjsfgkw.cn/Notice/NoticeKTSearch", False
        html.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        html.send ("pageno=" & I & "&pagesize=500&cbfy=%E5%85%A8%E9%83%A8&")
        Application.Wait Now() + VBA.TimeValue("00:00:02")
        strText = html.responseText
        If InStr(strText, "list") = False Then GoTo ghb
        Set js = CreateObject("ScriptControl")
        js.Language = "JavaScript": js.AddObject "g", Range("A1").Offset((I - 1) * 500)
        js.eval "o=" & strText & ";l=['FY','FT','KTRQ','PQRQ','AH','AY','CBBM','SPZ','YG','BG'];a=o.list;for(i=0;i<a.length;i++){for(k=0;k<l.length;k++){g(i+2,k+1)=a[i][l[k]];}};"
         Application.StatusBar = I * 500 & " 条数据ok!......"
    Next
    Application.ScreenUpdating = True
ghb:
    Application.StatusBar = "ok!"
    Application.Wait Now() + VBA.TimeValue("00:00:03")
    Application.StatusBar = False
End Sub

Kaohsing

'//实现array 的isarray方法

Sub 扩展方法()
   
    Set js = CreateObject("msscriptcontrol.scriptcontrol"):    js.Language = "javascript"
   
    js.addcode "if (!Array.isArray) {" _
        & " Array.isArray = function(arg) { return Object.prototype.toString.call(arg) === '[object Array]';  };}" _
        & "  function judge(){var a=[1,2,3];if (Array.isArray(a)){return 'Yes,I am Array'}return 'no';}"
   
    cc = js.eval("judge()")
    MsgBox cc
   
End Sub

Kaohsing

1. 
   
2. Sub 扩展array_from_isArray_js()
   
3.     Dim js As Object
   
4.     Dim s  As String
   
5.     Set js = CreateObject("msscriptcontrol.scriptcontrol")
   
6.     js.Language = "javascript"
   
7.     s = "if (!Array.from){" _
   
8.         & " Array.from = function (s){ if( typeof(s) == 'string'){ var arr = []; for(var i=0,len=s.length; i <len; i++){ arr[i] = s.charAt(i);}  return arr;} else{return Array.prototype.slice.call(s);  } ;}; " _
   
9.         & " };if (!Array.isArray) {Array.isArray = function(arg) { return Object.prototype.toString.call(arg) === '[object Array]';  };};" _
   
10.         & "; var z; var y;function j(a){  if(Array.isArray(a)){ y=a; return y };  z= Array.from(a);return z;}"
    
11.     js.addcode s
    
12.     ghb = Array("'我是js字符串'", "['我是js数组',2,3]", "{0: 1, 1: '我是类数组', 2: 3, length: 3}")
    
13.     For i = 0 To 2
    
14.         Debug.Print js.eval("j(" & ghb(i) & ")")
    
15.     Next
    
16. 
    
17. End Sub

复制代码

Kaohsing

odds500部分数据： odds500.rar (6.26 KB, 下载次数: 27)

2018-9-22 11:13 上传

点击文件名下载附件