On clicking refresh button; it asks for PINCode. On entering PINCode, it shows 10 rows data points(location) within 10 km surroundings using a web service(Alternative to hitting database with ADO)
Sub findLocation()
Dim xmlhtp As New MSXML2.XMLHTTP60
Dim Parameter1 As String, baseurl As String
Dim xmlDoc As New DOMDocument60
Dim nodeList As IXMLDOMNodeList
Dim node As IXMLDOMNode, pincode As String
Dim rowcount As Long
Dim location As String, city As String, pcode As String
ThisWorkbook.Sheets(1).Range("A3") = "City"
ThisWorkbook.Sheets(1).Range("B3") = "Location"
ThisWorkbook.Sheets(1).Range("C3") = "PINCode"
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If (rowcount > 3) Then
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).ClearContents
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Interior.ColorIndex = xlNone
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Borders.LineStyle = xlNone
End If
rowcount = 3
'taking input paramater PINCODE
pincode = Application.InputBox("Please enter Pincode to search Location", "PINCode", Type:=2)
'webService
baseurl = "http://api.geonames.org/findNearbyPostalCodes?postalcode=" & pincode & "&country=In&radius=10&username=somu&maxRows=10"
With xmlhtp
'GET is simpler and faster than POST, and can be used in most cases.
'However, always use POST requests when:
'A cached file is not an option (update a file or database on the server)
'Sending a large amount of data to the server (POST has no size limitations)
'Sending user input (which can contain unknown characters), POST is more robust and secure than GET
.Open "POST", baseurl, False
'Requests that are being sent are based on two parts: the Header and the Body.
'The Header contains information about the Body so that the receiver knows what data is contained there.
.setRequestHeader "Content-Type", "text/xml;"
'Sends an HTTP request to the server and receives a response. oXMLHttpRequest.send(varBody)
'varBody [optional]--The body of the message being sent with the request.
'This method is synchronous or asynchronous, depending on the value of the bAsync parameter in the open method call.
'If open is called with bAsync == False, this call does not return until the entire response is received or the protocol
'stack times out. If open is called with bAsync == True, this call returns immediately.
.send
xmlDoc.LoadXML .responseText
Set nodeList = xmlDoc.SelectNodes("/geonames/code")
For Each node In nodeList
location = node.SelectSingleNode("name").Text
city = node.SelectSingleNode("adminName1").Text
pcode = node.SelectSingleNode("postalcode").Text
ThisWorkbook.Sheets(1).Range("B" & (rowcount + 1)) = (location)
ThisWorkbook.Sheets(1).Range("A" & (rowcount + 1)) = (city)
ThisWorkbook.Sheets(1).Range("C" & (rowcount + 1)) = (pcode)
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Next node
ThisWorkbook.Sheets(1).Columns("A:C").AutoFit
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Interior.ColorIndex = 20
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Borders.LineStyle = xlContinuous
ThisWorkbook.Sheets(1).Range("A3:C3").Interior.ColorIndex = 37
ThisWorkbook.Sheets(1).Range("A3:C3").Font.Bold = True
End With
End Sub
Download File
Sub findLocation()
Dim xmlhtp As New MSXML2.XMLHTTP60
Dim Parameter1 As String, baseurl As String
Dim xmlDoc As New DOMDocument60
Dim nodeList As IXMLDOMNodeList
Dim node As IXMLDOMNode, pincode As String
Dim rowcount As Long
Dim location As String, city As String, pcode As String
ThisWorkbook.Sheets(1).Range("A3") = "City"
ThisWorkbook.Sheets(1).Range("B3") = "Location"
ThisWorkbook.Sheets(1).Range("C3") = "PINCode"
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
If (rowcount > 3) Then
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).ClearContents
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Interior.ColorIndex = xlNone
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Borders.LineStyle = xlNone
End If
rowcount = 3
'taking input paramater PINCODE
pincode = Application.InputBox("Please enter Pincode to search Location", "PINCode", Type:=2)
'webService
baseurl = "http://api.geonames.org/findNearbyPostalCodes?postalcode=" & pincode & "&country=In&radius=10&username=somu&maxRows=10"
With xmlhtp
'GET is simpler and faster than POST, and can be used in most cases.
'However, always use POST requests when:
'A cached file is not an option (update a file or database on the server)
'Sending a large amount of data to the server (POST has no size limitations)
'Sending user input (which can contain unknown characters), POST is more robust and secure than GET
.Open "POST", baseurl, False
'Requests that are being sent are based on two parts: the Header and the Body.
'The Header contains information about the Body so that the receiver knows what data is contained there.
.setRequestHeader "Content-Type", "text/xml;"
'Sends an HTTP request to the server and receives a response. oXMLHttpRequest.send(varBody)
'varBody [optional]--The body of the message being sent with the request.
'This method is synchronous or asynchronous, depending on the value of the bAsync parameter in the open method call.
'If open is called with bAsync == False, this call does not return until the entire response is received or the protocol
'stack times out. If open is called with bAsync == True, this call returns immediately.
.send
xmlDoc.LoadXML .responseText
Set nodeList = xmlDoc.SelectNodes("/geonames/code")
For Each node In nodeList
location = node.SelectSingleNode("name").Text
city = node.SelectSingleNode("adminName1").Text
pcode = node.SelectSingleNode("postalcode").Text
ThisWorkbook.Sheets(1).Range("B" & (rowcount + 1)) = (location)
ThisWorkbook.Sheets(1).Range("A" & (rowcount + 1)) = (city)
ThisWorkbook.Sheets(1).Range("C" & (rowcount + 1)) = (pcode)
rowcount = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Next node
ThisWorkbook.Sheets(1).Columns("A:C").AutoFit
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Interior.ColorIndex = 20
ThisWorkbook.Sheets(1).Range("A4:C" & rowcount).Borders.LineStyle = xlContinuous
ThisWorkbook.Sheets(1).Range("A3:C3").Interior.ColorIndex = 37
ThisWorkbook.Sheets(1).Range("A3:C3").Font.Bold = True
End With
End Sub
Download File
No comments:
Post a Comment