Excel Freezing when getting html SourceCode

[AndrewKent]

Hi there,

I started a thread a while back but didn't get any answers on it, probably because I wasn't explicit enough about the issues I was facing. The coding seen below works fine 90% of the time, but occasionally it will freeze. It's always at the same place, the line after the status "Step 3 of 5":

Function GetSource(sURL As String) As String

'   =============================================================================================

'   =============================================================================================

    On Error GoTo NoData

    Dim oXHTTP As Object
    
    Application.StatusBar = "Retrieving Source Code (Step 1 of 5), please wait..."
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    Application.StatusBar = "Retrieving Source Code (Step 2 of 5), please wait..."
    oXHTTP.Open "GET", sURL, False
    Application.StatusBar = "Retrieving Source Code (Step 3 of 5), please wait..."
    oXHTTP.send
    Application.StatusBar = "Retrieving Source Code (Step 4 of 5), please wait..."
    GetSource = oXHTTP.responsetext
    Application.StatusBar = "Retrieving Source Code (Step 5 of 5), please wait..."
    Set oXHTTP = Nothing
    
NoData:

End Function

This is the line that activates the function:

strSourceCode = GetSource("" & strFS_ActiveAddress & "")

which could contain a link like this:

http://msn.foxsports.com/foxsoccer/mls/scores?week=23&timeframe=1

Can anyone recommend some sort of time out update that if a connection cannot be made after a few seconds that the program waits, then tries again?

Kind regards,

Andy

 

[AndrewKent]

Since my other thread was "policed" I'll need to bump this one.

Does ANYONE know how to wrap the ".send" section up in some sort of timeout routine so that if no connection is made within say, 5 seconds, that it stops and trys again?

Kind regards,

Andy

 

[Zaf]

Interesting, I have retrieved source code this way without much trouble...

Does your code consistently fail for a given web address? Or is it a more random thing...

Sub Test()
Dim URL As String
URL = "[URL]http://www.abs.gov.au/AUSSTATS/abs@.nsf/mf/8501.0[/URL]"
Dim txt As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
txt = .ResponseText
End With
End Sub

 

[xenou]

This might work for a ten second timeout (untested). At least it won't freeze on you this way.

Function GetSource(sURL As String) As String
Dim myTime As Date

    On Error Resume Next

    Dim oXHTTP As Object
    
    Application.StatusBar = "Retrieving Source Code, please wait..."
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", sURL, False
    oXHTTP.send

    myTime = Now + TimeValue("00:00:10")
    Do While (oXHTTP.ReadyState <> 4) And (Now < myTime)
        DoEvents
    Loop
    
    GetSource = oXHTTP.responsetext
    Set oXHTTP = Nothing
    
End Function