Kod:
Sub GTWebAccess(ByVal Tgtrw as Long)
Dim IE As New InternetExplorer
Dim Doc As HTMLDocument
Dim NodeList
Dim Elem
Dim X
'IE.Visible = True
IE.navigate "Find Us=" & Range("A" & Tgtrw).Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set Doc = IE.document
Application.EnableEvents = False
' Retrieve the Outlet from the h4 tag
Range("B" & Tgtrw).Value = Trim(Doc.getElementsByTagName("h4")(0).innerText)
X = 1
' Retrieve the Paragraph tags
Set NodeList = Doc.getElementsByTagName("p")
For Each Elem In NodeList
'
' The Paragraph info is located in paragraphs 1 through 6
' 1 and 2 contain the Address
' 3 and 4 contain the Telephone
' 5 and 6 contain the E-mail
Select Case X
Case Is = 2
If Elem.innerText = "Just fill in your details" Then
Range("B" & Tgtrw).Value = "Please enter a valid Post Code"
Application.EnableEvents = True
IE.Quit
Set IE = Nothing
Exit Sub
Else
Range("C" & Tgtrw).Value = Elem.innerText
End If
Case Is = 4
Range("D" & Tgtrw).Value = Elem.innerText
Case Is = 6
Range("E" & Tgtrw).Value = Elem.innerText
End Select
X = X + 1
Next Elem
Application.EnableEvents = True
IE.Quit
Set IE = Nothing
' Set columns B through E column width to 32
Columns("B:E").ColumnWidth =32
End Sub