Multi-session / asynchronous web request with VBA and XMLHttpRequest object – Part 2

In PART 1, we talked about how to download files from the internet using XMLHTTP object. In this chapter, we will talk about how to achieve asynchronous and multi-session file download.

First we need to create a class called Httphelper:

Option Explicit
Private m_exportpath As String
Private m_httprequest As MSXML2.XMLHTTP60

Sub request(ByVal url As String, ByVal exportpath As String)
m_exportpath = exportpath
Set m_httprequest = New MSXML2.XMLHTTP60
m_httprequest.OnReadyStateChange = Me
m_httprequest.Open "GET", url, True
m_httprequest.send ""

End Sub

Sub OnReadyStateChange()

   If m_httprequest.readyState = 4 Then
      If m_httprequest.Status = 200 Then
         save_binary m_httprequest.responseBody
     End If
   End If

End Sub

Sub save_binary(ByRef b() As Byte)

Open m_exportpath For Binary As #1
  Put #1, , b
Close #1

End Sub

After creating the class, you have to export the class to text .cls file and edit the .cls file in text editor:

Add the following code:

Attribute OnReadyStateChange.VB_UserMemId = 0

under

Sub OnReadyStateChange()

Next, you need to import the .cls file into your VBA project, and finally we can use the class like this:

Sub main()
Set http_collection = New Collection
Dim http As Httphelper
For i = 1 To 9
    Set http = new_http
    http.request "http://ichart.finance.yahoo.com/table.csv?s=000" & i & ".hk", "C:\TEMP\" & i & ".csv"
Next i
End Sub

Function new_http() As Httphelper
    Set new_http = New Httphelper
End Function

Handling Object with collection

Sometimes, it is tricky to handle when you have to instance multiple objects during run time. However, you can apply this simple trick to automatically add custom objects to a collection.

Add these code into your module:

Option Explicit

Public obj_id As Integer
Public obj_col As collection

Sub test()

Dim c As Class1
Dim i As Integer
Dim obj As Object
Set obj_col = New collection
obj_id = 0

For i = 1 To 50
    Set c = New Class1
Next

For Each obj In obj_col
    obj.sayhi
Next

'release resources
Set obj_col = Nothing
End Sub

Add a new class module called “class1”. Within class1, add these code:

Private id As Integer

Private Sub Class_Initialize()
obj_id = obj_id + 1
id = obj_id
obj_col.Add Me, CStr(id)
End Sub

Public Sub sayhi()
Debug.Print "id:" & id
End Sub

Now try to run sub test().