Sometimes you want to retrieve information from the internet for use in an Office Application like Excel. For example, you might want to fetch the latest currency rates or the latest news topics from a website.
One way to do that is by using the XMLHTTP object. Generally this is considered to be faster than using the Internet Explorer Document Object Model (IE DOM) because, among other reasons, the latter requires an Internet Explorer instance.
Another advantage of the XMLHTTP object is that this object has equivalent implementations in other browsers such as Mozilla, Safari, Konquerer, Icebrowser and Opera, meaning written code around this object can be easily ported for use with other browsers.
How it works
The XMLHTTP object can be used to send or receive information to and from a webserver. Retrieved information can be parsed with the XML Document Object Model (XML DOM). In this first article about the XMLHTTP object I’ll show you how to use this object to retrieve selected information from a webpage for use in an VBA application.
For client-side communication with HTTP servers we are going to use the MSXML.XMLHTTPRequest object with the Open method. This initiates the actual request to webserver and parses the server response. To capture the return in simple text (HTML is simple text as well) we use the responseText property and assign it to a string variable. We then do some filtering on the string value in Excel to extract the information we need.
Sub GetLatestScriptoriumPosts() Dim i As Integer Dim sURL As String, sHTML As String, sAllPosts As String Dim oHttp As Object Dim lTopicstart As Long, lTopicend As Long Dim blWSExists As Boolean 'Create a new Worksheet "Latest Scriptorium Posts" if it doesnt'exist already. For i = 1 To Worksheets.Count If Worksheets(i).Name = "Latest Scriptorium Posts" Then blWSExists = True Worksheets(i).Activate End If Next If Not blWSExists Then Worksheets.Add.Move after:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = "Latest Scriptorium Posts" End If 'URL to open sURL = "http://scriptorium.serve-it.nl/environments.php?eid=1" ' Create an XMLHTTP object and add some error trapping On Error Resume Next Set oHttp = CreateObject("MSXML2.XMLHTTP") If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest") MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object" End If On Error GoTo 0 If oHttp Is Nothing Then MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object" Exit Sub End If 'Open the URL in browser object oHttp.Open "GET", sURL, False oHttp.Send sHTML = oHttp.responseText 'Extract the desired information from the returned HTML code (text) 'To make things a little easier I usually cut of most of the unwanted code first 'so sHTML is smaller to work with. lTopicstart = InStr(1, sHTML, "Recent additions", vbTextCompare) lTopicend = InStr(1, sHTML, "</table>", vbTextCompare) sHTML = Mid(sHTML, lTopicstart, lTopicend - lTopicstart) 'Now extract all text within the hyperlinks <a href..>..</a> 'because they represent the topics i = 1 lTopicstart = 1 lTopicend = 1 Do While lTopicstart <> 0 i = i + 1 lTopicstart = InStr(lTopicend, sHTML, "<a href=", vbTextCompare) If lTopicstart <> 0 Then lTopicstart = InStr(lTopicstart, sHTML, ">", vbTextCompare) + 1 lTopicend = InStr(lTopicstart, sHTML, "</a>", vbTextCompare) Worksheets(Worksheets.Count).Range("A2").Offset(i, 0).Value = _ Mid(sHTML, lTopicstart, lTopicend - lTopicstart) sAllPosts = sAllPosts & Chr(13) & Mid(sHTML, lTopicstart, lTopicend - lTopicstart) End If Loop 'Clean up Set oHttp = Nothing Worksheets(Worksheets.Count).Range("A1").Value = "Latest posts on Scriptorium:" MsgBox ("Latest posts on Scriptorium:" & Chr(13) & sAllPosts) End Sub
Add the sub routine to a new module and run it to see it work. This code loads the Scriptorium VBA webpage (my old website) and filters out the most recently added scripts titles. It then shows the titles of those in both a message (MsgBox) and in a worksheet with the name “Latest Scriptorium Posts”.
Courtesy: vba & excel