Excel vba获取html数据

13799809955

大家好，我要获取一个网站的html数据，我用F12分析，不是json的数据，是html的数据，打开它的里面网址，却看不到数据，请问用VBA怎么实现下载html的数据？网站http://www.pinble.com/Lottery.htm  里面的开奖信息，全国开奖 排列三。



我要把里面的开奖数字和期号时间读取到Excel中，用VBA的方式。请问大家，有什么办法吗？感谢。

chentonny

是html的数据，打开它的里面网址却看不到数据。

既然是html里的数据，怎么可能打开它的里面网址，却看不到数据。

所以，要么你的前半句错了，要么你的后半门口错了

deadzlq

PQ参考解法

feeyii

这是个嵌套网页，
要先打开 http://www.pinble.com/Lottery.htm
再从这个页面上跳到 排列三 开奖号页面上，
直接打开 排列三 开奖号页面是不行的。
在 .send前先要设置头部

        .setrequestheader "Host", "www.pinble.com"
        .setrequestheader "Referer", "http://www.pinble.com/Lottery.htm"
        .send

13799809955

feeyii 发表于 2020-5-14 14:57
这是个嵌套网页，
要先打开 http://www.pinble.com/Lottery.htm
再从这个页面上跳到 排列三 开奖号页面上 ...

你好，那个排列三的网址确实是http://www.pinble.com/Lottery.htm，但是要点击里面的排列三，才有具体数据，我现在是要下载里面的具体数据，要怎么弄？能写几句看看吗？我只处理过json的数据，那个读取过来，直接就是一大串字符串，然后用split函数切割就行，这种网站的情况，我还没处理过，不会弄，请指教。万分感谢！

13799809955

deadzlq 发表于 2020-5-14 14:19
PQ参考解法

你好，感谢你的热心回答，我不是要获取你显示的数据，你抓到的是首页的数据，我要抓里面具体的历史数据，就像我第一张图片里显示的一样，是里面的具体历史数据。

feeyii

Sub PL3()
Dim objXML As Object
Set reg = CreateObject("VBScript.RegExp")

myStr = "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"

Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objXML
        .Open "POST", myStr, False
        
        .setrequestheader "Host", "www.pinble.com"
        .setrequestheader "Referer", "http://www.pinble.com/Lottery.htm"
        .send

        txtContent = .responseText

End With

With reg
        .Global = True
        .Pattern = " \d{4}-\d{2}-\d{2}"
        Set 日期 = .Execute(txtContent)
        .Pattern = " \d{7}"
        Set 期号 = .Execute(txtContent)
        .Pattern = "\d{3}</span>"
        Set 开奖号 = .Execute(txtContent)
        t = 日期.Count
End With

Cells(1, 1) = "日期"
Cells(1, 2) = "期号"
Cells(1, 3) = "开奖号"
For i = 0 To t - 1
Cells(i + 2, 1) = 日期(i)
Cells(i + 2, 2) = 期号(i)
Cells(i + 2, 3) = Replace(开奖号(i), "</span>", "")
Next i


Set objXML = Nothing
Set reg = Nothing

End Sub


用正则表达式

phsu

Sub test()
    Dim myStr As String
    Dim Tables
    Dim i As Integer
    Dim j As Integer
    Dim nRow As Integer
    Dim nCol As Byte
    Dim Arr()
    With CreateObject("winhttp.winhttprequest.5.1")
        .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
        .setrequestheader "Referer", "http://www.pinble.com/Lottery.htm"
        .send
        myStr = .responsetext
    End With
    With CreateObject("htmlfile")
        .write myStr
        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 = Tables(2).Rows(i).Cells.Length
                For j = 0 To nCol - 1
                    Arr(i, j) = Tables(2).Rows(i).Cells(j).innertext
                Next j
            Next i
        End With
        With ActiveSheet
            .Cells.Clear
            .Range("A1").Resize(nRow, nCol) = Arr
        End With
    End With
End Sub

phsu

請參閱附件。

13799809955

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

万分感谢，可以用哦。我要好好研究一下。