Raspado de la web usando XHR desde siriusxm.com

Necesito extraer el artista y la canción que se está reproduciendo actualmente en http://www.siriusxm.com/siriusxmhits1 . Puedo hacer que esto funcione para navegar en el sitio web con Internet Explorer, pero lleva demasiado tiempo, así que he intentado usar WINHTTP.WinHTTPRequest.5.1 y MSXML2.serverXMLHTTP pero ninguno extrae los datos específicos que estoy buscando. Creo que estoy cerca pero me falta algo.

A continuación se muestra el fragmento de HTML:

 

Chainsmokers/Coldplay

Something Just Like This

...
...

Aquí está mi código actual:

 Sub GetData() Dim getArtist As Object Dim getSong As Object Set xmHtml = New HTMLDocument With CreateObject("WINHTTP.WinHTTPRequest.5.1") .Open "GET", "http://www.siriusxm.com/siriusxmhits1", False .send xmHtml.body.innerHTML = .responseText End With Set getArtist = xmHtml.getElementById("onair-pdt").getElementsByTagName("p")(0) MsgBox (getArtist.innerText) Set getSong = xmHtml.getElementById("onair-pdt").getElementsByTagName("p")(1) MsgBox (getSong.innerText) End Sub 

Si activo Internet Explorer funcionará con el siguiente código, pero eso lleva demasiado tiempo para lo que necesito hacer:

 Sub GetData() Dim DivID As HTMLObjectElement Dim getArtist As Variant Dim getSong As Variant URL = "http://www.siriusxm.com/siriusxmhits1" With IExplore .Navigate URL .Visible = False Do While .readyState  4: DoEvents: Loop Set doc = .document Set DivID = doc.getElementById("onair-pdt") getArtist = DivID.getElementsByClassName("onair-pdt-artist")(0).innerText getSong = doc.getElementsByClassName("onair-pdt-song")(0).innerText End With End Sub 

El sitio web http://www.siriusxm.com tiene una especie de API disponible. Navegué por una página con el enlace http://www.siriusxm.com/hits1 en Chrome, luego abrí la ventana Herramientas para desarrolladores ( F12 ), pestaña Red y examiné XHR en la lista. La información actual de la canción se puede recuperar, por ejemplo, en los siguientes pasos:

A continuación se muestra la muestra que muestra la estructura de respuesta JSON, yo uso la herramienta en línea http://jsonviewer.stack.hu :

Respuesta JSON

Puede usar el siguiente código de VBA para recuperar información como se describe arriba. Importe el módulo JSON.bas al proyecto VBA para el procesamiento JSON.

 Option Explicit Sub Test_siriusxm_com() Dim s As String Dim d As Date Dim sUrl As String Dim vJSON As Variant Dim sState As String Dim sArtists As String Dim sComposer As String Dim sAlbum As String Dim sSong As String ' Retrieve timestamp With CreateObject("MSXML2.XMLHTTP") .Open "GET", "http://www.siriusxm.com/sxm_date_feed.tzi", False .send s = .responseText End With ' Parse timestamp to Date type d = CDate(DateSerial(Mid(s, 5, 4), Mid(s, 3, 2), Mid(s, 1, 2)) + TimeSerial(Mid(s, 9, 2), Mid(s, 11, 2), Mid(s, 13, 2))) ' Add 4 hours to get UTC from EDT timezone d = DateAdd("h", 4, d) ' Combine URL with timestamp sUrl = "http://www.siriusxm.com/metadata/pdt/en-us/json/channels/siriushits1/timestamp/" & _ LZ(Month(d), 2) & "-" & _ LZ(Day(d), 2) & "-" & _ LZ(Hour(d), 2) & ":" & _ LZ(Minute(d), 2) & ":" & _ "00" ' Retrieve channelMetadataResponse JSON data With CreateObject("MSXML2.XMLHTTP") .Open "GET", sUrl, False .send s = .responseText End With ' Parse JSON response JSON.Parse s, vJSON, sState ' Check if valid If sState <> "Object" Then MsgBox "Invalid JSON response" Exit Sub End If ' Check if available If vJSON("channelMetadataResponse")("messages")("code") <> "100" Then MsgBox "Unavailable content" Exit Sub End If ' Get necessary properties Set vJSON = vJSON("channelMetadataResponse")("metaData")("currentEvent") sArtists = vJSON("artists")("name") sComposer = vJSON("song")("composer") sAlbum = vJSON("song")("album")("name") sSong = vJSON("song")("name") ' Output results MsgBox "On the Air" & vbCrLf & _ "Artists: " & sArtists & vbCrLf & _ "Composer: " & sComposer & vbCrLf & _ "Album: " & sAlbum & vbCrLf & _ "Song: " & sSong End Sub Function LZ(n As String, q As Long) As String ' Add leading zeroes LZ = Right(String(q, "0") & n, q) End Function 

Por cierto, el mismo enfoque utilizado en esto , esto y esto responde.