Hello young_86,
The macro code below is called by the button on"Sheet1". This has been added to the attached workbook. This level of knowledge is more advanced than what you will find easily either on the web or in books. I will answer you questions as best as I can.
Module1 Code
' Thread: http://www.excelforum.com/excel-programming-vba-macros/897133-pull-data-from-webpage.html
' Poster: young_86
' Written: February 04, 2013
' Author: Leith Ross www.excelforum.com
Sub GetPostalCodes()
Dim City As String
Dim Data(3) As Variant
Dim Doc As Object
Dim oTable As Object
Dim PageSource As String
Dim r As Long
Dim Rng As Range
Dim URL As String
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("B4")
City = Wks.Range("D2").Text
If City = "" Then
MsgBox "Please enter the name of a City.", vbExclamation + vbOKOnly
Wks.Range("D2").Select
Exit Sub
End If
Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
If RngEnd.Row >= Rng.Row Then Wks.Range(Rng, RngEnd).Resize(ColumnSize:=UBound(Data) + 1).ClearContents
URL = "http://www.geonames.org/postalcode-search.html?q=" & City & "&country="
' Retrieve the HTML text from the site (Page Source).
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
PageSource = .ResponseText
End With
' Create the HTML Document object from the HTML text.
Set Doc = CreateObject("htmlfile")
Doc.Open URL:="text/html", Replace:=True
Doc.write PageSource
For Each Item In Doc.getElementsByTagName("table")
If Item.Classname = "restable" Then
Set oTable = Item
End If
Next Item
If oTable Is Nothing Then
Rng.Value = "No results were returned."
Exit Sub
End If
For i = 1 To oTable.Rows.Length - 1 Step 2
With oTable.Rows(i)
For c = 0 To 3
Data(c) = GetCellText(.Cells(c))
Next c
End With
Rng.Offset(r, 0).Resize(ColumnSize:=UBound(Data) + 1).Value = Data
r = r + 1
Next i
End Sub
Function GetCellText(ByRef objHTML As Object)
' Find the cell's text using recursion.
If objHTML Is Nothing Then
GetCellText = ""
Exit Function
End If
If objHTML.HasChildNodes Then
Set objHTML = objHTML.LastChild
GetCellText objHTML
End If
If objHTML.NodeName = "#text" Then
GetCellText = objHTML.NodeValue
Else
GetCellText = objHTML.innerHTML
End If
End Function
Bookmarks