如何通过VBA抓取跳转网站上的数据？

PPYZX

想通过VBA编写在不打开IE的情况下，后台抓取指定网站上的数据并保存到EXCEL中，但是由于该网站有文本输入和保密跳转，和普通的直接抓取不太一样，试了好久都没成功。恳求VBA大拿帮忙编写一下代码。

网址：https://sgmwhsfs.wjx.cn/resultquery.aspx?activity=15976219

输入变量为工号（假定来自sheet1!A1，设定一个值为133671），点击查询后，返回得分值（76）输入到sheet1!B1

恳求VBA大拿指导，不胜感激。

PPYZX

求EXCELHOME的大能出来帮忙写几句啊~~

PPYZX

恳求各位大拿，如果成功，给第一个大拿发个30元小红包聊表心意。

fxl447098457

有两个成绩单，我只查询了第二个分数76.用msgbox提示框显示成绩的。要查询第一个试卷成绩只需要将代码里的divData2改为divData1即可。代码供参考。
Sub getdata()
Dim http As Object, dom As Object, 工号 As Long, Url As String, btnSubmit As String, hfQuery As String
Dim VIEWSTATE As String, VIEWSTATEGENERATOR As String, EVENTVALIDATION As String, PostData As String
Dim joinid As String, ts As String, in_dex As String, s_ign As String, url2 As String, Strtext$, 成绩
Set http = CreateObject("msxml2.xmlhttp")
Set dom = CreateObject("htmlfile")
工号 = 133671
Url = "https://sgmwhsfs.wjx.cn/resultquery.aspx?activity=15976219"
With http
    .Open "GET", Url, False
    .send
    dom.body.innerhtml = .responsetext
    VIEWSTATE = zm(dom.getElementById("__VIEWSTATE").Value)
    VIEWSTATEGENERATOR = zm(dom.getElementById("__VIEWSTATEGENERATOR").Value)
    EVENTVALIDATION = zm(dom.getElementById("__EVENTVALIDATION").Value)
    EVENTVALIDATION = zm(dom.getElementById("__EVENTVALIDATION").Value)
    btnSubmit = zm(dom.getElementById("btnsubmit").Value)
    hfQuery = zm("20000|" & 工号)
    PostData = "__VIEWSTATE=" & VIEWSTATE & "&__VIEWSTATEGENERATOR=" & VIEWSTATEGENERATOR & _
    "&__EVENTVALIDATION=" & EVENTVALIDATION & "&btnSubmit=" & btnSubmit & "&hfQuery=" & hfQuery

    .Open "POST", Url, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", ""
    .send (PostData)
    dom.body.innerhtml = .responsetext
    Set result = dom.getElementById("divData2")
    joinid = result.joinid: ts = result.ts: s_ign = result.parterSign: in_dex = result.Index
    url2 = "https://sgmwhsfs.wjx.cn/handler/JoinDetail.ashx?activityid=15976219&joinid=" & _
    joinid & "&ts=" & ts & "&sign=" & s_ign & "&index=" & in_dex
    .Open "GET", url2, False
    .send
    Strtext = .responsetext
    成绩 = Val(Split(Strtext, "form__items--rt figcaption form__score'><strong>")(1))
    MsgBox "工号为" & 工号 & "考试分数为:" & 成绩
End With
End Sub
Private Function zm(s As String)
With CreateObject("htmlfile")
  .write "<script></script>"
  zm = .Parentwindow.eval("encodeURIComponent('" & s & "')")
End With
End Function

PPYZX

fxl447098457 发表于 2018-6-25 09:52
有两个成绩单，我只查询了第二个分数76.用msgbox提示框显示成绩的。要查询第一个试卷成绩只需要将代码里的d ...

非常感谢，测试可用，有以下2点能否再帮忙调整一下。
1、在不知道后台会有几个数据的情况下，能否全部查出来并只显示次数和最高分？
2、工号手动修改后，程序调试出错。是不是因为只有1个数据的话就会报错？第1条改好了就是不是就不会有这个问题了。

另外，麻烦报一个支付宝账户给我，测试OK后发个小红包意思一下哈

fxl447098457

PPYZX 发表于 2018-6-25 11:29
非常感谢，测试可用，有以下2点能否再帮忙调整一下。
1、在不知道后台会有几个数据的情况下，能否全部查 ...

你可以上个excel压缩包附件,多提供几个出问题的工号列表给我测试。上面的代码其实已经把核心问题解决掉了，后面的都是些小case。

PPYZX

fxl447098457 发表于 2018-6-25 11:41
你可以上个excel压缩包附件,多提供几个出问题的工号列表给我测试。上面的代码其实已经把核心问题解决掉了 ...

151577
129983
137795
128402
以上几个工号，麻烦测试一下啦

PPYZX

fxl447098457 发表于 2018-6-25 11:41
你可以上个excel压缩包附件,多提供几个出问题的工号列表给我测试。上面的代码其实已经把核心问题解决掉了 ...

显示“*小蕾”的支付宝账号，没错吧？

fxl447098457

PPYZX 发表于 2018-6-25 12:06
显示“*小蕾”的支付宝账号，没错吧？

没有错，就是我。。

fxl447098457

PPYZX 发表于 2018-6-25 12:04
151577
129983
137795

试过了，做了下微调，考试次数和最高分都可以查询出来了。

Sub getdata()
Dim http As Object, dom As Object, 工号 As Long, Url As String, btnSubmit As String, hfQuery As String
Dim VIEWSTATE As String, VIEWSTATEGENERATOR As String, EVENTVALIDATION As String, PostData As String
Dim joinid As String, ts As String, in_dex As String, s_ign As String, url2 As String, Strtext$, 成绩
Dim res As Object, result As Object, i As Integer, scount As Integer, arr(), Max_Score
Set http = CreateObject("msxml2.xmlhttp")
Set dom = CreateObject("htmlfile")
工号 = 128402
Url = "https://sgmwhsfs.wjx.cn/resultquery.aspx?activity=15976219"
With http
    .Open "GET", Url, False
    .send
    dom.body.innerhtml = .responsetext
    VIEWSTATE = zm(dom.getElementById("__VIEWSTATE").Value)
    VIEWSTATEGENERATOR = zm(dom.getElementById("__VIEWSTATEGENERATOR").Value)
    EVENTVALIDATION = zm(dom.getElementById("__EVENTVALIDATION").Value)
    EVENTVALIDATION = zm(dom.getElementById("__EVENTVALIDATION").Value)
    btnSubmit = zm(dom.getElementById("btnsubmit").Value)
    hfQuery = zm("20000|" & 工号)
    PostData = "__VIEWSTATE=" & VIEWSTATE & "&__VIEWSTATEGENERATOR=" & VIEWSTATEGENERATOR & _
    "&__EVENTVALIDATION=" & EVENTVALIDATION & "&btnSubmit=" & btnSubmit & "&hfQuery=" & hfQuery

    .Open "POST", Url, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .setRequestHeader "Referer", ""
    .send (PostData)
    dom.body.innerhtml = .responsetext
    Set res = dom.getElementById("divData")
If InStr(res.innerhtml, "query__amount") = 0 Then
        scount = 1
        Max_Score = Val(Split(res.innerhtml, "form__items--rt figcaption form__score""><STRONG>")(1))
    Else
        scount = Val(Split(res.innerhtml, "<DIV class=query__amount>共")(1)) '考试次数

    For i = 1 To scount Step 1
        ReDim Preserve arr(1 To i)
        Set result = dom.getElementById("divData" & i)
    joinid = result.joinid: ts = result.ts: s_ign = result.parterSign: in_dex = result.Index
    url2 = "https://sgmwhsfs.wjx.cn/handler/JoinDetail.ashx?activityid=15976219&joinid=" & _
    joinid & "&ts=" & ts & "&sign=" & s_ign & "&index=" & in_dex
    .Open "GET", url2, False
    .send
    Strtext = .responsetext
    arr(i) = Val(Split(Strtext, "form__items--rt figcaption form__score'><strong>")(1))
    Next i
    Max_Score = Application.Max(arr)
End If
    MsgBox "工号为" & 工号 & "考试次数为:" & scount & "次,最高分数为:" & Max_Score
End With
End Sub
Private Function zm(s As String)
With CreateObject("htmlfile")
  .write "<script></script>"
  zm = .Parentwindow.eval("encodeURIComponent('" & s & "')")
End With
End Function