Importing web query from web script error

[Bucko3030]

Hi I have been using a web query to imports data for my hockey pool. I been importing it for about 2 years now from yahoo sports everything was fine. Untill yesterday yahoo must have change something now I can't import the data any more I go check my connection I get script error line 18512 char 1 error 'Y' is undefined code 0 here is the webpage i use NHL - Statistics by Position - Yahoo Canada Sports it was easy to import before i would just put the yellow arrow next the players name and save now i can't put the arrow by the players now i can only import the whole web page but then my code don't work.

 

[Bucko3030]

Thanks for getting backup to me I did what you said but I get this error now Run time error '-2147467259 Method 'Busy' Object 'Iwebbrowser 2' Failed. When I click debug
While .Busy Or .ReadyState <> 4
Is what is highlighted

 

[ukmikeb]

Hi

I ran the code successfully with the changes.

Can you list the code you have.

 

[Bucko3030]

Sub Bucko3030()
'
' Bucko3030 Macro
'
Dim aBrowser As Object
Dim htm As Object
Dim elemCollection As Object
Dim URLPArray
Dim ShtArray
Dim MyArray
Dim d As Long, r As Long, c As Long
Dim i As Integer

URLPArray = Array("C,RW,LW,D", "G&conference=NHL&year=season_2013&qualified=1")
ShtArray = Array("Players", "Goalies")
Application.Calculation = xlCalculationManual
For i = 0 To 1
Sheets(ShtArray(i)).Select
Range("A1").Select

Set aBrowser = CreateObject("InternetExplorer.Application")
With aBrowser
.Silent = True
.Visible = False
.Navigate "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & """"
While .Busy Or .ReadyState <> 4: DoEvents: Wend
End With

Set htm = aBrowser.Document
Set elemCollection = htm.getElementsBytagName("table")(4)

For r = 0 To elemCollection.Rows.Length - 1
ReDim MyArray(elemCollection.Rows(0).Cells.Length - 1)
d = 0
For c = 0 To elemCollection.Rows(r).Cells.Length - 1
If c > 2 And elemCollection.Rows(r).Cells(c).innertext = Chr$(32) Then GoTo Nxtc
MyArray(d) = elemCollection.Rows(r).Cells(c).innertext
d = d + 1
Nxtc:
Next c

Cells(r + 1, 1).Resize(, elemCollection.Rows(0).Cells.Length) = MyArray
Nxtr:
Next r
Set aBrowser = Nothing
Set htm = Nothing
Set elemCollection = Nothing
Next i
Application.Calculation = xlCalculationAutomatic
'
End Sub

 

[ukmikeb]

Hi

Thanks

I think your .Navigate line is causing the problem, change the quadruple double quotes to double double quotes.

If that doesn't work put a space between the double double quotes.

hth

 

[Bucko3030]

Sub Bucko3030()
'
' Bucko3030 Macro
'
Dim aBrowser As Object
Dim htm As Object
Dim elemCollection As Object
Dim URLPArray
Dim ShtArray
Dim MyArray
Dim d As Long, r As Long, c As Long
Dim i As Integer

URLPArray = Array("C,RW,LW,D", "G&conference=NHL&year=season_2013&qualified=1")
ShtArray = Array("Players", "Goalies")
Application.Calculation = xlCalculationManual
For i = 0 To 1
Sheets(ShtArray(i)).Select
Range("A1").Select

Set aBrowser = CreateObject("InternetExplorer.Application")
With aBrowser
.Silent = True
.Visible = False
.Navigate "[URL]http://ca.sports.yahoo.com/nhl/stats/byposition?pos[/URL]=" & URLPArray(i) & ""
While .Busy Or .ReadyState <> 4: DoEvents: Wend
End With

Set htm = aBrowser.Document
Set elemCollection = htm.getElementsBytagName("table")(4)

For r = 0 To elemCollection.Rows.Length - 1
ReDim MyArray(elemCollection.Rows(0).Cells.Length - 1)
d = 0
For c = 0 To elemCollection.Rows(r).Cells.Length - 1
If c > 2 And elemCollection.Rows(r).Cells(c).innertext = Chr$(32) Then GoTo Nxtc
MyArray(d) = elemCollection.Rows(r).Cells(c).innertext
d = d + 1
Nxtc:
Next c

Cells(r + 1, 1).Resize(, elemCollection.Rows(0).Cells.Length) = MyArray
Nxtr:
Next r
Set aBrowser = Nothing
Set htm = Nothing
Set elemCollection = Nothing
Next i
Application.Calculation = xlCalculationAutomatic
'
End Sub

Still getting a error saying The remote server machine doesn't exist or is unavailable when I debug its still the
While .Busy Or .ReadyState <> 4

that is highlighted

 

[ukmikeb]

Hi

I've run it successfully many times under Excel 2007 and IE10.

I recall that when IE11 was posted as "the Browser to have" I upgraded only to swiftly do an about face when I encountered some issues.

If you continue to receive this message

The remote server machine doesn't exist or is unavailable

then possibly IE is getting upset with "the country boundaries". I'm in UK but it doesn't affect me.

 

[Bucko3030]

you have the same setup as me I have excel 2007 and IE10. I wonder what would cause this to happen can you post the code you tried so I can try it maybe I did something wrong?? not sure why my gives me that error

 

[ukmikeb]

Hi

Here is the code :-

Sub Bucko3030()
'
' Bucko3030 Macro
'
 Dim aBrowser As Object
 Dim elemCollection As Object, htm As Object
 Dim d As Long, r As Long, c As Long
 Dim MyArray, myURL
    
 Dim URLPArray
 Dim ShtArray
 
 URLPArray = Array("C,RW,LW,D", "G&conference=NHL&year=season_2013&qualified=1")
 ShtArray = Array("Players", "Goalies")
 
 For i = 0 To 1
    Sheets(ShtArray(i)).Select
    
    If i = 0 Then
        Range("NHL2010_Players").Offset(2).ClearContents
    Else
        Range("NHL2010_Goalies").Offset(2).ClearContents
    End If
 
    myURL = "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=" & URLPArray(i) & ""
    
    Set aBrowser = CreateObject("InternetExplorer.Application")
    With aBrowser
        .Silent = True
        .Visible = False
        .Navigate myURL
        While .Busy: DoEvents: Wend
        While .ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend
    End With
    
    Set htm = aBrowser.Document

    Set elemCollection = htm.getElementsByTagName("table")(4)
    
    For r = 0 To elemCollection.Rows.Length - 1
        ReDim MyArray(elemCollection.Rows(0).Cells.Length - 1)
        d = 0
        For c = 0 To elemCollection.Rows(r).Cells.Length - 1
            If c > 2 And elemCollection.Rows(r).Cells(c).innertext = Chr$(32) Then GoTo Nxtc
                MyArray(d) = elemCollection.Rows(r).Cells(c).innertext
                d = d + 1
Nxtc:
        Next c
        
        Cells(r + 1, 1).Resize(, elemCollection.Rows(0).Cells.Length) = MyArray
Nxtr:
    Next r

    Set aBrowser = Nothing
    Set htm = Nothing
    Set elemCollection = Nothing
Next i

'
End Sub

I have removed the statements regarding Application.Calculation.

I have converted the While statement into two separate statements as the OR Not test doesn't seem logical.

The process seems to take a while to complete the Players sheet and then it completes the Goalies sheet much faster.

Hope it works for you this time.

 

[sportshelp]

I'm having the same issues the OP had with yahoo sports statistics. I'm trying to import the NFL season stats NFL - Statistics by Team - Yahoo Sports

I tried substituting the above URL in the code provided below but it doesn't seem to work. Any help would be greatly appreciated!

Sub Yahoo()
    Dim aBrowser As Object
    Set aBrowser = CreateObject("InternetExplorer.Application")
    Dim Coll As Object, HT As Object
    Dim r As Long, c As Long
    
    With aBrowser
        .Silent = True
        .Visible = False
        .Navigate "http://ca.sports.yahoo.com/nhl/stats/byposition?pos=C,RW,LW,D"
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
    End With
    
    Set HT = aBrowser.Document
    Set Coll = HT.getElementsByTagName("table")
    
    Application.Calculation = xlCalculationManual
    For r = 0 To Coll(4).Rows.Length - 1
        For c = 0 To Coll(4).Rows(r).Cells.Length - 1
            Cells(r + 1, c + 1) = Coll(4).Rows(r).Cells(c).innerText
        Next
    Next
    Application.Calculation = xlCalculationAutomatic
    
    Set aBrowser = Nothing: Set HT = Nothing: Set Coll = Nothing
End Sub

 

[VBA Geek]

does this work for you?

Sub imp_NFL()
Const URL = "http://sports.yahoo.com/nfl/stats/byteam?group=Offense&cat=Passing&conference=NFL&year=season_2014&sort=42&old_category=Passing&old_group=Offense"
Dim oXML As Object, oHTML As Object, x As Long, y As Long
Set oXML = CreateObject("MSXML2.XMLHTTP")
Set oHTML = CreateObject("HTMLFILE")
With oXML
    .Open "GET", URL, False
    .send
    oHTML.body.innerHTML = .responseText
End With
With oHTML.getElementsByTagName("Table").Item(6)
    For x = 0 To .Rows.Length - 1
        For y = 0 To .Rows(x).Cells.Length - 1
            Range("A1").Offset(x, y).Value = .Rows(x).Cells(y).innerText
        Next
    Next x
End With
MsgBox "Done", vbOKOnly
Set oXML = Nothing
Set oHTML = Nothing
End Sub