用vba 抓取一个网页的数据，以前有过一个可用的现在换了 请问怎么写程序

uume

用vba 抓取一个网页的数据，以前有过一个可用的现在换了 请问怎么写程序网址 https://sv.baidu.com/videoui/page/videoland?pd=bjh&context=%7B"nid"%3A"sv_10284366175196515355"%2C"sourceFrom"%3A"bjh"%7D&fr=bjhauthor&type=video&type=news
抓取播放量的数据。
程序：

Sub Main()

    Dim strText As String
    Dim reg As New RegExp, mcs As MatchCollection
    Dim wk As Workbook: Set wk = ThisWorkbook
    Dim sh As Worksheet: Set sh = wk.ActiveSheet
    Dim arr, i As Long
    Dim t As Date
    t = Timer
    With sh
        Dim EndRow As Long: EndRow = .Cells(.Rows.Count, "A").End(3).Row
        arr = .Range("a1:f" & EndRow)
    End With
    ReDim brr(1 To UBound(arr), 1 To 4)
    brr(1, 1) = "名称"
    brr(1, 3) = "播放量"
    brr(1, 4) = "网址"
    brr(1, 2) = "时间"
    reg.Pattern = "<div class=""video-play-times"">(.+?)</div>"
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For i = 2 To UBound(arr)

            Dim url As String: url = arr(i, 6)
            If url <> "" Then
                DoEvents
                .Open "GET", url, False
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .Send
                strText = .Responsetext '请自行拷贝之前的常用函数
                Dim mNum As String
                If reg.test(strText) Then
                    Set mcs = reg.Execute(strText)
                    mNum = mcs(0).SubMatches(0)
                End If

                brr(i, 3) = mNum
            End If
            brr(i, 1) = arr(i, 1)
            brr(i, 4) = arr(i, 6)
            brr(i, 2) = arr(i, 5)
        Next i
    End With
    Set sh = wk.Worksheets("结果")
    With sh
        .Cells.Clear
        .Range("a1").Resize(UBound(brr), 4) = brr
    End With
    Erase arr, brr
    sh.Copy

    MsgBox Format(Timer - t, "0.00")
    End
End Sub



现在需要抓取这个网页播放的数据，该如何更改呢？
http://post.mp.qq.com/kan/video/201106565-7165b2c9e88324aj-rFxktz.html?_wv=2281701505&sig=47a12cd629f4e442f00c02498b6d5003&time=1529650824
希望哪位大神给个答复