Scriptorium

us fr nl




VBA : Internet: Loading information from the internet in Excel using the XMLHTTP Object   nl


Options: Save as PDF | Save attached file | Toggle line numbers

Details:

Type: sub
Added By: Rembo
Short Description:
Please check the improved article on my new website here:
http://www.vba-and-excel.com/vba/internet/6-loading-information-from-the-internet-using-the-xmlhttp-object

This routine shows you how to use the XMLHTTP object to retrieve information from the internet in Excel. 

This object doesn't require an instance of Internet Explorer to be started and is generally considered to be faster then the IE Document object (which does require an IE instance). In addition this object has equivalent implementations in other browsers such as Mozilla, Safari, Konquerer, Icebrowser and Opera meaning written code around the XMLHTTP object can be easily ported for use with other browsers.
Notes:
The XMLHTTP object can be used to send or receive information to/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 plain text as well) we use the responseText property and set it equal to a string variable. We then do some filtering in Excel to extract the information we need.
Added: Jan 31 2006 at 11:42 AM
Modified: Jun 13 2013 at 4:29 PM
Related URLs


Usage:

Run the sub routine to see it work.
This code loads the Scriptorium VBA page 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".


Code:

Formatted | Unformatted
  1. Sub GetLatestScriptoriumPosts()
  2. Dim i As Integer
  3. Dim sURL As String, sHTML As String, sAllPosts As String
  4. Dim oHttp As Object
  5. Dim lTopicstart As Long, lTopicend As Long
  6. Dim blWSExists As Boolean
  7. 'Create a new Worksheet "Latest Scriptorium Posts" if it doesnt'exist already.
  8. For i = 1 To Worksheets.Count
  9. If Worksheets(i).Name = "Latest Scriptorium Posts" Then
  10. blWSExists = True
  11. Worksheets(i).Activate
  12. End If
  13. Next
  14. If Not blWSExists Then
  15. Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
  16. Worksheets(Worksheets.Count).Name = "Latest Scriptorium Posts"
  17. End If
  18. 'URL to open
  19. sURL = "http://scriptorium.serve-it.nl/environments.php?eid=1"
  20. ' Create an XMLHTTP object and add some error trapping
  21. On Error Resume Next
  22. Set oHttp = CreateObject("MSXML2.XMLHTTP")
  23. If Err.Number <> 0 Then
  24. Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
  25. MsgBox "Error 0 has occured while creating a MSXML.XMLHTTPRequest object"
  26. End If
  27. On Error GoTo 0
  28. If oHttp Is Nothing Then
  29. MsgBox "For some reason I wasn't able to make a MSXML2.XMLHTTP object"
  30. Exit Sub
  31. End If
  32. 'Open the URL in browser object
  33. oHttp.Open "GET", sURL, False
  34. oHttp.Send
  35. sHTML = oHttp.responseText
  36. 'Extract the desired information from the returned HTML code (text)
  37. 'To make things a little easier I usually cut of most of the unwanted code first
  38. 'so sHTML is smaller to work with.
  39. lTopicstart = InStr(1, sHTML, "Recent additions", vbTextCompare)
  40. lTopicend = InStr(1, sHTML, "</table>", vbTextCompare)
  41. sHTML = Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
  42. 'Now extract all text within the hyperlinks <a href..>..</a>
  43. 'because they represent the topics
  44. i = 1
  45. lTopicstart = 1
  46. lTopicend = 1
  47. Do While lTopicstart <> 0
  48. i = i + 1
  49. lTopicstart = InStr(lTopicend, sHTML, "<a href=", vbTextCompare)
  50. If lTopicstart <> 0 Then
  51. lTopicstart = InStr(lTopicstart, sHTML, ">", vbTextCompare) + 1
  52. lTopicend = InStr(lTopicstart, sHTML, "</a>", vbTextCompare)
  53. Worksheets(Worksheets.Count).Range("A2").Offset(i, 0).Value = _
  54. Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
  55. sAllPosts = sAllPosts & Chr(13) & Mid(sHTML, lTopicstart, lTopicend - lTopicstart)
  56. End If
  57. Loop
  58. 'Clean up
  59. Set oHttp = Nothing
  60. Worksheets(Worksheets.Count).Range("A1").Value = "Latest posts on Scriptorium:"
  61. MsgBox ("Latest posts on Scriptorium:" & Chr(13) & sAllPosts)
  62. End Sub



User comments :

Add a new comment   Back to Top
Atom Feed
Contact | About This Application | Scriptorium Website