View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default 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