More Local Search To Excel
So I’m going with the trend that J-Walk started here, Mark continued, now I thought I’d show how to do the same *without* using Excel 2003.
I based my code on Mark’s worksheet. Here it is:
Sub YahooSearchExcel()
Dim Query As String, Zip As String
Dim URL As String
Dim xmlObj As Object 'XMLHTTP
Dim node As Object 'MSXML2.IXMLDOMNode
Dim basenode As Object 'MSXML2.IXMLDOMNode
Dim i As Long
Dim vMatch As Variant
Query = Range("localquery").Value
Zip = Range("localzipfix").Value
URL = "http://api.local.yahoo.com/LocalSearchService/V1/" & _
"localSearch?appid=ExcelLocalSearch&query=" & _
Query & "&zip=" & Zip & "&results=20"
Set xmlObj = CreateObject("Microsoft.XMLHTTP")
xmlObj.Open "GET", URL, False
xmlObj.Send
If xmlObj.StatusText = "OK" Then
Range("D2:IV65536").Clear
Set basenode = xmlObj.responseXML.documentElement
For Each node In basenode.childNodes
If node.baseName = "Result" Then
'Add the results
With Cells(Rows.Count, 4).End(xlUp).Offset(1)
For i = 0 To node.childNodes.Length - 1
'Are we importing this element ?
vMatch = Empty
vMatch = Application.Match(node.childNodes(i).baseName, Range("1:1"), 0)
If IsNumeric(vMatch) Then
.Offset(, vMatch - 4).Value = node.childNodes(i).Text
End If
Next i
End With
End If
Next node
End If
Set node = Nothing
Set basenode = Nothing
Set xmlObj = Nothing
End Sub
Dim Query As String, Zip As String
Dim URL As String
Dim xmlObj As Object 'XMLHTTP
Dim node As Object 'MSXML2.IXMLDOMNode
Dim basenode As Object 'MSXML2.IXMLDOMNode
Dim i As Long
Dim vMatch As Variant
Query = Range("localquery").Value
Zip = Range("localzipfix").Value
URL = "http://api.local.yahoo.com/LocalSearchService/V1/" & _
"localSearch?appid=ExcelLocalSearch&query=" & _
Query & "&zip=" & Zip & "&results=20"
Set xmlObj = CreateObject("Microsoft.XMLHTTP")
xmlObj.Open "GET", URL, False
xmlObj.Send
If xmlObj.StatusText = "OK" Then
Range("D2:IV65536").Clear
Set basenode = xmlObj.responseXML.documentElement
For Each node In basenode.childNodes
If node.baseName = "Result" Then
'Add the results
With Cells(Rows.Count, 4).End(xlUp).Offset(1)
For i = 0 To node.childNodes.Length - 1
'Are we importing this element ?
vMatch = Empty
vMatch = Application.Match(node.childNodes(i).baseName, Range("1:1"), 0)
If IsNumeric(vMatch) Then
.Offset(, vMatch - 4).Value = node.childNodes(i).Text
End If
Next i
End With
End If
Next node
End If
Set node = Nothing
Set basenode = Nothing
Set xmlObj = Nothing
End Sub
It is a lot easier letting Excel handle the XML transformation.
I’m somewhat new to using VB so forgive me if my question addresses what is obvious to others. I created a spreadsheet and created the macro by plugging in the code above. I then setup cells comparable to the appearance of the sample spreadsheet from Mark so that a query cell with blank cell below it and a zip code cell with a blank below it existed. I then associated the names localquery and localzipfix(referenced in the code) to the appropriate blank cells. I put a zip and a query word in and when I run the code nothing at all happens. What am I doing wrong or do I still need to do?
Noticed that one element in Mark’s example I didn’t see in your code was the range though that is the least of my worries.
Thanks for your help.
Hi Nomad,
The code also expects the “headings” in row 1. That is because the XML file from Yahoo returns a lot more information, so we’re delimiting what we want to show to the user. Here’s a sample Excel file with my code only:
http://www.mrexcel.com/YahooLocal.zip
Works like a charm. Thanks.
Any chance you’ve been able to figure out how to include the radius element of a search?
I just believed Mark that it didn’t work with the radius…
d’oh … didn’t realize he’d mentioned that specifically … thanks for the reply 8-D
[...] who was disappointed the Yahoo local only worked in Excel 2003: Juan Pablo González posted a nice version of the Yahoo local spreadsheet that works with ver [...]
[...] t (Radius X Miles), doch das klappt laut Kommentaren (noch?) nicht. Für Excel <2002: Link (siehe Kommentar mit Link auf Zip-Datei oder halt den Quellcode im [...]
Any way to automatically convert the URL’s from text to real links? The only way I know of is to manually select the cell, press F2 and then Enter to convert it to a hyperlink.