Check URL exists in Webquery

[Bruce]

I have the following webquery that retrieves data from the web. Before I
refresh it I would like to validate the URL exists and is valid. If it
doesn't then I would like to send a message and end the macro.

How do I go about this? Should I set a timeout factor?

Bruce

Sub getQuote()

Dim QuerySheet As Worksheet, DataSheet As Worksheet
Dim qurl As String, qStart As String, queryTags As String
Dim i As Integer
Dim nQuery As Name

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set DataSheet = ActiveSheet
queryLink = "http://finance.yahoo.com/d/quotes.csv?s="
queryTags = "nb3b2l1c6p2pohgva2kjd1t1"

qStart = "C7"

Range(qStart).CurrentRegion.ClearContents

i = 7
qurl = queryLink + Cells(i, 1)
i = i + 1
While Cells(i, 1) <> ""
qurl = qurl + "+" + Cells(i, 1)
i = i + 1
Wend
qurl = qurl + "&f=" + queryTags

QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,
Destination:=DataSheet.Range(qStart))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Range(qStart).CurrentRegion.TextToColumns
Destination:=Range(qStart), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

Columns("C:C").EntireColumn.AutoFit
Call Del_Name_Range

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("A5").Select
End Sub

Function Del_Name_Range()
For Each N In Sheet26.Names
If InStr(N.Name, "ExternalData") > 0 Then N.Delete
Next N
End Function

 

[Joel]

I went to the yahoo lookup page for stocks and used a web browser application
to find if a stock exists and how many stock were returned. Try this code
below.

Sub findStock()
StockName = "xabc"
Quantity = GetStock(StockName)

End Sub

Function GetStock(ByVal StockName As String)

NoResults = "There are no"

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URLLOOKUP = "http://finance.yahoo.com/lookup?s="
URL = URLLOOKUP & StockName
'get web page
IE.Navigate2 URL
Do While IE.readyState <> 4 Or _
IE.Busy = True
DoEvents
Loop

Set form = IE.document.getElementsByTagName("Form")

Set Results = IE.document.getElementById("yfi_sym_results")

If Left(Results.innertext, Len(NoResults)) = NoResults Then
GetStock = 0
Else
Set Quantity = IE.document.getElementById("yfi_sym_lookup")
Text = Quantity.innertext
'get number from parenthesis
Quant = Mid(Text, InStr(Text, "(") + 1)
Quant = Val(Quant)


a = 1
GetStock = Quant
End If

IE.Quit


End Function

 

[Bruce]

Thanks Joel,

Not quite what I was looking for.

Here's a bit more of an explanation.

You can assume that the URL is correct. The test is more of a check that
either a) a internet correction is present or b) the site is currently up.

Bruce

 

[Joel]

I added a timeout test. does this help?

Sub findStock()
StockName = "xabc"
Quant = GetStock(StockName)

End Sub

Function GetStock(ByVal StockName As String)

NoResults = "There are no"

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URLLOOKUP = "http://finance.yahoo.com/lookup?s="
URL = URLLOOKUP & StockName
TimeOut = False
StartTime = Now
'get web page
IE.Navigate2 URL
Do While IE.readyState <> 4 Or _
IE.Busy = True
DoEvents
CurrentTime = Now
If Second(CurrentTime - StartTime) > 30 Then
TimeOut = True
GetStock = -1
Exit Do
End If
Loop

If TimeOut = False Then
Set form = IE.document.getElementsByTagName("Form")

Set Results = IE.document.getElementById("yfi_sym_results")

If Left(Results.innertext, Len(NoResults)) = NoResults Then
GetStock = 0
Else
Set Quantity = IE.document.getElementById("yfi_sym_lookup")
Text = Quantity.innertext
'get number from parenthesis
Quant = Mid(Text, InStr(Text, "(") + 1)
Quant = Val(Quant)
GetStock = Quant
End If
End If

IE.Quit

End Function

 

[oitbso]

I have the following webquery that retrieves data from the web. Before I
refresh it I would like to validate the URL exists and is valid. If it
doesn't then I would like to send a message and end the macro.

How do I go about this? Should I set a timeout factor?

Bruce

Sub getQuote()

    Dim QuerySheet As Worksheet, DataSheet As Worksheet
    Dim qurl As String, qStart As String, queryTags As String
    Dim i As Integer
    Dim nQuery As Name

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set DataSheet = ActiveSheet
    queryLink = "http://finance.yahoo.com/d/quotes.csv?s="
    queryTags = "nb3b2l1c6p2pohgva2kjd1t1"

    qStart = "C7"

    Range(qStart).CurrentRegion.ClearContents

    i = 7
    qurl = queryLink + Cells(i, 1)
    i = i + 1
    While Cells(i, 1) <> ""
        qurl = qurl + "+" + Cells(i, 1)
        i = i + 1
    Wend
    qurl = qurl + "&f=" + queryTags

QueryQuote:
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,
Destination:=DataSheet.Range(qStart))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With

            Range(qStart).CurrentRegion.TextToColumns
Destination:=Range(qStart), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False

            Columns("C:C").EntireColumn.AutoFit
            Call Del_Name_Range

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Range("A5").Select
End Sub

Function Del_Name_Range()
    For Each N In Sheet26.Names
     If InStr(N.Name, "ExternalData") > 0 Then N.Delete
    Next N
End Function

Bruce...I often use the following method to retrieve data from a web
page. The method actually retrieves the source code behind the web
page and assigns it to a variable which can then be parsed for the
desired information. Once you have the response text in hand, you can
check it for some phrase that appears on the desired webpage.
Something like...

my_url = "http://www.google.com"
Set my_obj = CreateObject("MSXML2.XMLHTTP")
my_obj.Open "GET", my_url, False
my_obj.send
my_var = RL.responsetext
Set my_obj = Nothing

special_text = "some phrase from the webpage"

If instr(1, my_var, special_text, vbTextCompare) = 0 then
MsgBox ("The website is not available")
stop
End if

If you get beyond the error message, then the website is available and
you could run your query. But actually you already have all the page
info in my_var, so rather than run the query, you could just proceed
to extract the desired information from my_var...Ron