Check URL exists in Webquery
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" wrote:
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
|