通过excel实现高考成绩的快速查询

wudixin96

flysum2008 发表于 2011-10-9 12:56
请教老师，我抓到的网址为：
http://www.sneac.com/gkcjcx/2011zcjcx_jg.jsp?wbtreeid=3063?wbzkzh=0501 ...

不用去了wbtreeid=3063

只是因为你写了wbtreeid=3063?这里不是问号，是&

改wbtreeid=3063&就可以了

flysum2008

wudixin96 发表于 2011-10-9 13:04
不用去了wbtreeid=3063

只是因为你写了wbtreeid=3063?这里不是问号，是&

非常感谢老师指点，同时再次感谢您上次对我的帮助！

xmyjk

试看看附件：

1. Option Explicit
   
2. Sub test()
   
3. Dim tmp() As String, i As Integer, arr(8) As String, xmlhttp As Object, p As Long, tmp2() As String
   
4. Dim zkz As String, sfz As String, url As String
   
5. Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
   
6. For p = 2 To [a65536].End(3).Row
   
7.     zkz = Cells(p, 1): sfz = Cells(p, 2)
   
8.     url = "http://www.sneac.com/gkcjcx/2011zcjcx_jg.jsp?wbzkzh=" & zkz & "&wbsfzh=" & sfz
   
9.     With xmlhttp
   
10.         .Open "get", url, False
    
11.         .send
    
12.         tmp = Filter(Split(.responsetext, "</td>"), "<td align='center'>")
    
13.         tmp2 = Filter(Split(.responsetext, "</td>"), "679706692_3119"" >")
    
14.     End With
    
15.     For i = 0 To UBound(tmp)
    
16.        arr(i + 2) = Split(tmp(i), "<td align='center'>")(1)
    
17.     Next
    
18.     For i = 1 To 2
    
19.        arr(i - 1) = Split(tmp2(i), "679706692_3119"" >")(1)
    
20.     Next
    
21.     Cells(p, 3).Resize(1, 9) = arr
    
22.     Erase tmp, tmp2, arr
    
23.     zkz = "": sfz = "": url = ""
    
24. Next
    
25. 
    
26. Set xmlhttp = Nothing
    
27.    
    
28. MsgBox "Ok"
    
29. End Sub
    
30. 
    

复制代码

flysum2008

xmyjk 发表于 2011-10-9 13:09
试看看附件：

谢谢回复！厉害，这个方法我一直没掌握，主要是要分离代码，有时还要转换，比较麻烦。要是我能学到您的一半就好了，呵呵！

xmyjk

flysum2008 发表于 2011-10-9 13:23
谢谢回复！厉害，这个方法我一直没掌握，主要是要分离代码，有时还要转换，比较麻烦。要是我能学到您的一 ...

一般看编码（源代码能看出来）：

一般，就.responsetext就可以了。
如果是charset=gbk，就用StrConv(.responsebody, vbUnicode, &H804) （限于中文版OFFICE）

网页数据截取是体力活啦，无非是文本处理，可以向敌哥多学学正则{:soso_e102:}，就很容易超越我了。

flysum2008

xmyjk 发表于 2011-10-9 13:30
一般看编码（源代码能看出来）：

如果UTF-8，就.responsetext就可以了。

谢谢，又学了一招，您和敌哥都是我学习的榜样！

xmyjk

wudixin96 发表于 2011-10-9 13:04
不用去了wbtreeid=3063

只是因为你写了wbtreeid=3063?这里不是问号，是&

一般性的GET或POST都可以，XMLHTTP也可以模拟消息头进行POST的，不过如果有COOKIE等控制的页面，XMLHTTP比较难模拟就是了，还有AJAX技术的一些页面，也比较难用XMLHTTP操控。这时一般用WEBBROWSER/IE就是了。

flysum2008

xmyjk 发表于 2011-10-9 13:42
一般性的GET或POST都可以，XMLHTTP也可以模拟消息头进行POST的，不过如果有COOKIE等控制的页面，XMLHTTP比 ...

麻烦老师帮我看下，如何让查询网页不在IE中出现，而是出现在webbrowser里，谢谢！在网上搜索好长时间没找到答案

xmyjk

flysum2008 发表于 2011-10-9 13:56
麻烦老师帮我看下，如何让查询网页不在IE中出现，而是出现在webbrowser里，谢谢！在网上搜索好长时间没找 ...

刚看到，试看看：

1. Sub wz()
   
2. 'http://club.excelhome.net/thread-772576-1-1.html
   
3.     UserForm1.Show 0
   
4. 
   
5.     Set IE = UserForm1.WebBrowser1
   
6.     With IE
   
7.         .navigate "http://www.sneac.com/gkcxx/cjcx/zcjcx.htm "
   
8.         Do Until .readyState = 4
   
9.         DoEvents
   
10.         Loop
    
11. 
    
12.         .document.body.innerHTML = Replace(.document.body.innerHTML, "blank", "self")
    
13.         
    
14.         .document.all.tags("input")(0).Value = "0501151847"
    
15.         .document.all.tags("input")(1).Value = "610502199209278236"
    
16.         
    
17.         .document.all.tags("img")(1).Click  '查询
    
18.         
    
19.     End With
    
20. End Sub

复制代码

flysum2008

xmyjk 发表于 2011-10-9 14:33
刚看到，试看看：

非常感谢！测试成功。请问为什么加了这句 .document.body.innerHTML = Replace(.document.body.innerHTML, "blank", "self")就可以了呢？是修改了源代码吗？能解释下这么做的目的和原因吗？谢谢！