Excel vba获取html数据

13799809955

phsu 发表于 2020-5-14 21:50
Sub test()
    Dim myStr As String
    Dim Tables

万分感谢你的热心帮助，代码我试了一下，可以用，但是现在还有两个问题，第一，你这个代码获取的开奖数据，在0开头的时候就会把0遗漏掉。第二问题，是我要从最后一页的数据开始倒序开始获取，读取到的数据要先获取的放在第一行，后获取的放在后面。怎么实现数据页面的点击？我分析了最后一页的网址，和第一页的不同，是一个乱码格式，我看不懂。

phsu

(1)解決0遺漏的問題，可在寫入單元格之前設定C列格式為文字。
        With ActiveSheet
            .Cells.Clear
            .Columns("C").NumberFormat = "@"
            .Range("A1").Resize(nRow, nCol) = Arr
        End With
(2)要逐頁下載資料，改用POST下載，並賦予參數查詢。
(3)不必反過來查詢。直接從第一頁查到最後一頁，下載下來之後再排序即可。

13799809955

phsu 发表于 2020-5-20 22:17
(1)解決0遺漏的問題，可在寫入單元格之前設定C列格式為文字。
        With ActiveSheet
            .Ce ...

改用post的，怎么写，我还没写过post的。再排序，怎么弄？求指教，比较小白啊。大神。

13799809955

phsu 发表于 2020-5-20 22:17
(1)解決0遺漏的問題，可在寫入單元格之前設定C列格式為文字。
        With ActiveSheet
            .Ce ...

大神，你回的我的帖子，但里面我有好多函数，对象都看不懂，百度搜也解释得不清楚。所以还得请教你本人，能不能加个微信，当面向你请教。拜托。。。

phsu

這個網頁查詢第一頁時用GET，但切換查詢其他頁卻要改成POST。用POST查詢需要傳遞五個參數及其參數值，其中前兩個會由系統賦予，需要在GET時擷取。第三個是固定值。最後兩個是要查詢的頁碼及前一個頁碼。我試著在POST查詢時賦予所有表頭，發現若按照Fiddler截取封包裡面的Content-Type設定，查詢會錯誤；但若不賦予這個表頭，則無法傳回我們要的表格，只會傳回第一頁的資料。代碼如下，也許看看有哪位棧友能提供協助。
Sub test()
    Dim myStr As String
    Dim Tb, Tables
    Dim i As Integer
    Dim j As Integer
    Dim nRow As Integer
    Dim nCol As Byte
    Dim xRow As Integer
    Dim Arr()
    Dim Http, HtmlFile
    Dim VIEWSTATE As String
    Dim VIEWSTATEGENERATOR As String
    Dim EVENTTARGET As String
    Dim EVENTARGUMENT As String '查詢的頁碼
    Dim AspNetPager1_input As String '前一頁的頁碼
   
    Set Http = CreateObject("winhttp.winhttprequest.5.1")
    With Http
        .Open "GET", "http://www.pinble.com/LotteryOneList.aspx?type=3332858CC6D0DB930D85469DC90329E2&class=%E5%85%A8%E5%9B%BD%E4%BD%93%E5%BD%A9&lx=pls&name=%E6%8E%92%E5%88%97%E4%B8%89", False
        .Option(6) = False
        .setrequestheader "Referer", "http://www.pinble.com/Lottery.htm"
        .send
        myStr = .responsetext
    End With
    Set Http = Nothing
    '擷取參數值並抓取第一頁資料
    Set HtmlFile = CreateObject("htmlfile")
    With HtmlFile
        .write myStr
        '擷取參數值
        VIEWSTATE = .getelementbyid("__VIEWSTATE").getattribute("value")
        VIEWSTATEGENERATOR = .getelementbyid("__VIEWSTATEGENERATOR").getattribute("value")
        EVENTTARGET = "AspNetPager1"
        EVENTARGUMENT = "2" '查詢的頁碼，在此亦即第2頁
        AspNetPager1_input = "1" '前一頁碼，查詢第2頁之前所在的頁碼
        '抓取第一頁資料
        Set Tables = .all.tags("table")
        With Tables(2)
            nRow = .Rows.Length
            nCol = .Rows(1).Cells.Length
            ReDim Arr(0 To nRow - 1, 0 To nCol - 1)
            For i = 0 To nRow - 1
                nCol = .Rows(i).Cells.Length
                For j = 0 To nCol - 1
                    Arr(i, j) = .Rows(i).Cells(j).innertext
                Next j
            Next i
        End With
        With ActiveSheet
            .Cells.Clear
            .Columns("C").NumberFormat = "@"
            .Range("A1").Resize(nRow, nCol) = Arr
        End With
    End With
    Set HtmlFile = Nothing
    '查詢第二頁
    Set Http = CreateObject("winhttp.winhttprequest.5.1")
    With Http
        .Open "POST", "http://www.pinble.com/LotteryOneList.aspx?type=3332858CC6D0DB930D85469DC90329E2&class=%u5168%u56fd%u4f53%u5f69&lx=pls&name=%u6392%u5217%u4e09", False
        .setrequestheader "Accept", "text/html, application/xhtml+xml, image/jxr, */*"
        .setrequestheader "Referer", "http://www.pinble.com/LotteryOneList.aspx?type=3332858CC6D0DB930D85469DC90329E2&class=%E5%85%A8%E5%9B%BD%E4%BD%93%E5%BD%A9&lx=pls&name=%E6%8E%92%E5%88%97%E4%B8%89"
        .setrequestheader "Accept-Language", "en-US,en;q=0.8,zh-Hant-TW;q=0.5,zh-Hant;q=0.3"
        .setrequestheader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
        '.setrequestheader "Content-Type", "application/x-www-form-urlencoded"
        .setrequestheader "Accept-Encoding", "gzip, deflate"
        .setrequestheader "Cookie", "ASP.NET_SessionId=jehbt0urfdn3i1dlcntmkqki"
        .send "__VIEWSTATE=" & VIEWSTATE & "&__VIEWSTATEGENERATOR=" & VIEWSTATEGENERATOR & _
              "&__EVENTTARGET=" & EVENTTARGET & "&__EVENTARGUMENT=" & EVENTARGUMENT & _
              "&AspNetPager1_input=" & AspNetPager1_input
        myStr = .responsetext
    End With
    Set HtmlFile = CreateObject("htmlfile")
    With HtmlFile
        .write myStr
        Set Tables = .all.tags("table")
        i = 0
        For Each Tb In Tables
            Debug.Print Tb.innertext
            Debug.Print i
            Debug.Print "--------"
            i = i + 1
        Next
        With Tables(2)
            nRow = .Rows.Length
            nCol = .Rows(1).Cells.Length
            ReDim Arr(1 To nRow - 1, 0 To nCol - 1)
            For i = 1 To nRow - 1
                nCol = .Rows(i).Cells.Length
                For j = 0 To nCol - 1
                    Arr(i, j) = .Rows(i).Cells(j).innertext
                Next j
            Next i
        End With
    End With
    With ActiveSheet
        xRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A" & xRow + 1).Resize(nRow - 1, nCol) = Arr
    End With
End Sub

13799809955

feeyii 发表于 2020-5-14 21:06
Sub PL3()
Dim objXML As Object
Set reg = CreateObject("VBScript.RegExp")

你好，我还是遇到不能获取第2页以后数据的情况，15楼的大神帮我编了一下，好像也没成功，这个大神，你能帮忙解决一下吗？怎么获取第二页以后的数据，请指教。万分感谢。

chentonny

这么久还没搞定啊

feeyii

13799809955 发表于 2020-5-25 15:41
你好，我还是遇到不能获取第2页以后数据的情况，15楼的大神帮我编了一下，好像也没成功，这个大神，你能 ...

需要彩票开奖数据，
可以从这里下载
https://917500.cn/?s=/Home/Tools/download/tg/u5872.html

排3  2000期
http://data.917500.cn/tcpl32000.txt

13799809955

feeyii 发表于 2020-5-25 19:20
需要彩票开奖数据，
可以从这里下载
https://917500.cn/?s=/Home/Tools/download/tg/u5872.html

谢谢，看来你也玩彩吗？