Galactico
10-03-2017, 12:49 PM
Hello everyone
I have the following macros to get internet data, but, I can't adjust it to find the correct value on this site (it works with another site), I think I should change "principio" and "final", but I have not had success
I would greatly appreciate your help
Sub KaladeshCK1()
Application.ScreenUpdating = False
On Error Resume Next
web = "www.cardkingdom.com/mtg/kaladesh/Torrential-Gearhulk"
principio = "itemAddToCart NM active"
Final = "<div class=""dropdown"">"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "POST", web, False
XML.send
texto = XML.responsetext
posicion1 = InStr(texto, principio)
posicion2 = InStr(texto, Final)
dato = Mid(texto, posicion1, (posicion2 - posicion1))
Range("k4") = "Torrential Gearhulk"
If Err = 0 Then
Cotizacion = Split(dato, "<span class=""stylePrice""> $")
Range("l4") = Trim(Left(Cotizacion(1), 6))
Else
Application.ScreenUpdating = False
On Error Resume Next
principio = "itemAddToCart outOfStock NM active"
Final = "<div class=""outOfStockNotice"">"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "POST", web, False
XML.send
texto = XML.responsetext
posicion1 = InStr(texto, principio)
posicion2 = InStr(texto, Final)
dato = Mid(texto, posicion1, (posicion2 - posicion1))
If Err = 0 Then
Cotizacion = Split(dato, "<span class=""stylePrice""> $")
Range("l4") = Trim(Left(Cotizacion(1), 6))
'cambiar color de celda
'Range("d4").Interior.ColorIndex = 3
Range("l4").Font.ColorIndex = 3
End If
End If
Set XML = Nothing
Application.ScreenUpdating = True
End Sub
sorry for my english, not main language, thanks!
I have the following macros to get internet data, but, I can't adjust it to find the correct value on this site (it works with another site), I think I should change "principio" and "final", but I have not had success
I would greatly appreciate your help
Sub KaladeshCK1()
Application.ScreenUpdating = False
On Error Resume Next
web = "www.cardkingdom.com/mtg/kaladesh/Torrential-Gearhulk"
principio = "itemAddToCart NM active"
Final = "<div class=""dropdown"">"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "POST", web, False
XML.send
texto = XML.responsetext
posicion1 = InStr(texto, principio)
posicion2 = InStr(texto, Final)
dato = Mid(texto, posicion1, (posicion2 - posicion1))
Range("k4") = "Torrential Gearhulk"
If Err = 0 Then
Cotizacion = Split(dato, "<span class=""stylePrice""> $")
Range("l4") = Trim(Left(Cotizacion(1), 6))
Else
Application.ScreenUpdating = False
On Error Resume Next
principio = "itemAddToCart outOfStock NM active"
Final = "<div class=""outOfStockNotice"">"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "POST", web, False
XML.send
texto = XML.responsetext
posicion1 = InStr(texto, principio)
posicion2 = InStr(texto, Final)
dato = Mid(texto, posicion1, (posicion2 - posicion1))
If Err = 0 Then
Cotizacion = Split(dato, "<span class=""stylePrice""> $")
Range("l4") = Trim(Left(Cotizacion(1), 6))
'cambiar color de celda
'Range("d4").Interior.ColorIndex = 3
Range("l4").Font.ColorIndex = 3
End If
End If
Set XML = Nothing
Application.ScreenUpdating = True
End Sub
sorry for my english, not main language, thanks!