|
![](https://clubstatic.excelhome.net/image/common/ico_lz.png)
楼主 |
发表于 2018-7-11 15:06
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Public Sub 云南省公考成绩查询()
'本程序的难点是真实成绩查询网址的获取
Dim strURL As String
Dim strData As String
Dim xmlHttp As Object
'Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
Set oDoc = CreateObject("htmlfile")
Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With xmlHttp
For rowi = 2 To 5
.Open "POST", "http://www.ynzs.cn/2017gkcf/check.php?action=query", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", "http://www.ynzs.cn/2017gkcf/web.html"
.send "user=" & Cells(rowi, 1) & "&pass=" & Cells(rowi, 2)
strData = Replace(Replace(Replace(Split(.responseText, "url")(1), "}", ""), """:", ""), """", "")
strData = Replace(strData, "\", "")
.Open "GET", strData, False
.send
oDoc.body.innerHTML = Replace(ByteToStr(.responsebody, "UTF-8"), " ", "")
Set tr = oDoc.all.tags("Table")(0).Rows
Cells(rowi, 4) = tr(1).Cells(0).innerText
Cells(rowi, 5) = tr(1).Cells(1).innerText
Cells(rowi, 6) = tr(1).Cells(3).innerText
Cells(rowi, 7) = tr(2).Cells(1).innerText
Cells(rowi, 8) = tr(3).Cells(1).innerText
Cells(rowi, 9) = tr(4).Cells(1).innerText
Cells(rowi, 10) = tr(5).Cells(1).innerText
Cells(rowi, 11) = tr(6).Cells(1).innerText
Cells(rowi, 12) = Split(tr(7).Cells(0).innerText, ":")(1)
Next
End With
End Sub
Function ByteToStr(arrByte, strCharset As String) As String
With CreateObject("Adodb.Stream")
.Type = 1
.Open
.write arrByte
.Position = 0
.Type = 2
.Charset = strCharset
ByteToStr = .Readtext
.Close
End With
End Function
|
|