【求助】VBA网抓的问题

约定的童话

389004101 发表于 2021-2-11 10:05
我把扩展名改了，现在可以了。麻烦您下载了改回.xlsm

地址是对的，要用With CreateObject("WinHttp.WinHttpRequest.5.1")配合setRequestHeader "Cookie"进行数据获取

389004101

http://www.cwl.gov.cn/cwl_admin/ ... q&issueCount=30
这个源代码用正则很好匹配。现在的问题是VBA抓不到源代码

389004101

约定的童话 发表于 2021-2-11 10:12
地址解析的不对

那应该用什么方法呢？
确实，直接复制到浏览器也是打不开的；但是从链接跳转进去是有内容的，不明白什么原因，这方面我完全是小白。。

389004101

约定的童话 发表于 2021-2-11 10:12
地址解析的不对

那需要怎样修改呢？我怎么回复不了了。说要审核。

约定的童话

389004101 发表于 2021-2-11 10:42
那需要怎样修改呢？我怎么回复不了了。说要审核。

11楼分析，先吃饭

389004101

约定的童话 发表于 2021-2-11 10:12
地址是对的，要用With CreateObject("WinHttp.WinHttpRequest.5.1")配合setRequestHeader "Cookie"进行数 ...

我刚才百度了一下，是不是这种格式的？

1. Dim oXMLHttpRequest As Object
   
2. Set oXMLHttpRequest = CreateObject("Microsoft.XmlHttp")
   
3. oXMLHttpRequest.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
   
4. oXMLHttpRequest.setRequestHeader "Accept-Language", "ko-KR"
   
5. oXMLHttpRequest.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
   
6. oXMLHttpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
7. oXMLHttpRequest.setRequestHeader "Accept-Encoding", "gzip, deflate"
   
8. oXMLHttpRequest.setRequestHeader "Connection", "Keep-Alive"
   
9. oXMLHttpRequest.setRequestHeader "DNT", "1"
   
10. oXMLHttpRequest.setRequestHeader "Cookie", "xxx=yyy"
    
11. oXMLHttpRequest.send[enter image description here][1]

复制代码

389004101

1.     Set myHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   
2.     With myHTTP
   
3.         .Open "GET", "http://www.cwl.gov.cn/cwl_admin/kjxx/findDrawNotice?name=ssq&issueCount=30", False
   
4.         .setRequestHeader "Host", "www.cwl.gov.cn"
   
5.         .setRequestHeader "Connection", "keep-alive"
   
6.         .setRequestHeader "Upgrade-Insecure-Requests", "1"
   
7.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.25 Safari/537.36 Core/1.70.3861.400 QQBrowser/10.7.4313.400"
   
8.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
9.         .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
   
10.         .setRequestHeader "Referer", "http://club.excelhome.net/thread-1575009-1-1.html"
    
11.         .setRequestHeader "Accept-Encoding", "gzip, deflate"
    
12.         .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.9"
    
13.         .setRequestHeader "Cookie", "_ga=GA1.3.1058570018.1612955503; _gid=GA1.3.1852979334.1612955503; 21_vq=26"
    
14.         .send
    
15.     End With

复制代码

哈哈哈哈，依葫芦画瓢，成功了！！！！！

389004101

放出全部代码：

1. Sub wzssqkj()
   
2.     Dim myHTTP As Object, s As String
   
3.    
   
4.     'Set myHTTP = CreateObject("Microsoft.XmlHttp")
   
5.     'myHTTP.Open "GET", "http://datachart.500.com/ssq/history/newinc/history.php?limit=30&sort=0", False
   
6.     'myHTTP.send
   
7.     Set myHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   
8.     With myHTTP
   
9.         .Open "GET", "http://www.cwl.gov.cn/cwl_admin/kjxx/findDrawNotice?name=ssq&issueCount=30", False
   
10.         .setRequestHeader "Host", "www.cwl.gov.cn"
    
11.         .setRequestHeader "Connection", "keep-alive"
    
12.         .setRequestHeader "Upgrade-Insecure-Requests", "1"
    
13.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.25 Safari/537.36 Core/1.70.3861.400 QQBrowser/10.7.4313.400"
    
14.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
15.         .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
    
16.         .setRequestHeader "Referer", "http://club.excelhome.net/thread-1575009-1-1.html"
    
17.         .setRequestHeader "Accept-Encoding", "gzip, deflate"
    
18.         .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.9"
    
19.         .setRequestHeader "Cookie", "_ga=GA1.3.1058570018.1612955503; _gid=GA1.3.1852979334.1612955503; 21_vq=26"
    
20.         .send
    
21.     End With
    
22.    
    
23.     s = myHTTP.responsetext
    
24. 
    
25.     Dim regex As Object, mches As Object, mch As Object, i&, j&
    
26. 
    
27.     Set regex = CreateObject("VBScript.Regexp")
    
28.     regex.Global = True
    
29.     regex.Pattern = "code"":""(\d+).*?date"":""(.*?)"".*?(\d\d),(\d\d),(\d\d),(\d\d),(\d\d),(\d\d)"".*?(\d\d).*?typemoney"":""(\d+).*?typemoney"":""(\d+)"
    
30.    
    
31.     Set mches = regex.Execute(s)
    
32.    
    
33.     i = 2
    
34.     For Each mch In mches
    
35.         For j = 0 To 10
    
36.             Sheet7.Cells(i, j + 1) = mch.submatches(j)
    
37.         Next j
    
38.         i = i + 1
    
39.     Next mch
    
40. End Sub

复制代码

xiangbaoan

Sub wzssqkj()
  Dim url As String, s As String, oH As Object, ar(1 To 56789, 1 To 10), k As Long
  url = "http://www.cwl.gov.cn/cwl_admin/kjxx/findDrawNotice?name=ssq&issueCount="
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url & 50, False
    .setRequestHeader "Referer", "http://www.cwl.gov.cn/"
    .Send
    s = .ResponseText
  End With
  Set oH = CreateObject("htmlfile")
  GetJsonData oH.parentWindow, s, ar, k
  Cells.Clear
  Range("A2").Resize(k, 10) = ar
  Set oH = Nothing
End Sub

Function GetJsonData(oW As Object, s As String, ar(), k As Long)
  Dim i&, j&, n&, t
  With oW
    .execScript "var a=" & s & "['result'];"
    j = .eval("a.length")
    For i = 0 To j - 1
      k = k + 1
      ar(k, 1) = .eval("a[" & i & "]['code']")
      ar(k, 2) = .eval("a[" & i & "]['date']")
      t = Split(.eval("a[" & i & "]['red']"), ",")
      For n = 0 To UBound(t)
        ar(k, 3 + n) = t(n)
      Next
      ar(k, 8) = .eval("a[" & i & "]['blue']")
      ar(k, 9) = .eval("a[" & i & "]['prizegrades'][0]['typemoney']")
      ar(k, 10) = .eval("a[" & i & "]['prizegrades'][1]['typemoney']")
    Next
  End With
End Function