How to VBA catch request timeout error?

There are several complications here.

1. MSXML2.ServerXMLHTTP does not expose COM-usable events. Therefore it is not easily possible to instantiate an object using WithEvents and attach to its OnReadyStateChange event.
   The event is there, but the standard VBA way to handle it does not work.
2. The module that could handle the event cannot be created using the VBA IDE.
3. You need to call waitForResponse() when you use asynchronous requests (additionally to calling setTimeouts()!)
4. There is no timeout event. Timeouts are thrown as an error.

To resolve issue #1:

Usually a VBA class module (also applies to user forms or worksheet modules) allows you to do this:

Private WithEvents m_xhr As MSXML2.ServerXMLHTTP

so you can define an event handler like this:

Private Sub m_xhr_OnReadyStateChange()  ' ...End Sub

Not so with MSXML2.ServerXMLHTTP. Doing this will result in a Microsoft Visual Basic Compile Error: "Object does not source automation events".

Apparently the event is not exported for COM use. There is a way around this.

The signature for onreadystatechange reads

Property onreadystatechange As Object

So you can assign an object. We could create a class module with an onreadystatechange method and assign like this:

m_xhr.onreadystatechange = eventHandlingObject

However, this does not work. onreadystatechange expects an object and whenever the event fires, the object itself is called, not the method we've defined. (For the ServerXMLHTTP instance there is no way of knowing which method of the user-defined eventHandlingObject we intend to use as the event handler).

We need a callable object, i.e. an object with a default method (every COM object can have exactly one).
(For example: Collection objects are callable, you can say myCollection("foo") which is a shorthand for myCollection.Item("foo").)

To resolve issue #2:

We need a class module with a default property. Unfortunately these can't be created using the VBA IDE, but you can create them using a text editor.

• prepare the class module that contains an onreadystatechange function in the VBA IDE
• export it to a .cls file via right click
• open that in a text editor and add the following line beneath the onreadystatechange signature:
  Attribute OnReadyStateChange.VB_UserMemId = 0
• remove the original class module and and re-import it from file.

This will mark the modified method as Default. You can see a little blue dot in the Object Browser (F2), which marks the default method:

So every time the object is called, actually the OnReadyStateChange method is called.

To resolve issue #3:

Simply call waitForResponse() after send().

m_xhr.Sendm_xhr.waitForResponse timeout

In case of a timeout: If you did not call this method, the request simply never returns. If you did, an error is thrown after timeout milliseconds.

To resolve issue #4:

We need to use an On Error handler that catches the timeout error and transforms it into an event, for convenience.

Putting it all together

Here is a VB class module I wrote that wraps and handles an MSXML2.ServerXMLHTTP object. Save it as AjaxRequest.cls and import it into your project:

VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = "AjaxRequest"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseOption ExplicitPrivate m_xhr As MSXML2.ServerXMLHTTPAttribute m_xhr.VB_VarHelpID = -1Private m_isRunning As Boolean' default timeouts. TIMEOUT_RECEIVE can be overridden in requestPrivate Const TIMEOUT_RESOLVE As Long = 1000Private Const TIMEOUT_CONNECT As Long = 1000Private Const TIMEOUT_SEND As Long = 10000Private Const TIMEOUT_RECEIVE As Long = 30000Public Event Started()Public Event Stopped()Public Event Success(data As String, serverStatus As String)Public Event Error(data As String, serverStatus As String, xhr As MSXML2.ServerXMLHTTP)Public Event TimedOut(message As String)Private Enum ReadyState  XHR_UNINITIALIZED = 0  XHR_LOADING = 1  XHR_LOADED = 2  XHR_INTERACTIVE = 3  XHR_COMPLETED = 4End EnumPublic Sub Class_Terminate()  Me.CancelEnd SubPublic Property Get IsRunning() As Boolean  IsRunning = m_isRunningEnd PropertyPublic Sub Cancel()  If m_isRunning Then    m_xhr.abort    m_isRunning = False    RaiseEvent Stopped  End If  Set m_xhr = NothingEnd SubPublic Sub HttpGet(url As String, Optional timeout As Long = TIMEOUT_RECEIVE)  Send "GET", url, vbNullString, timeoutEnd SubPublic Sub HttpPost(url As String, data As String, Optional timeout As Long = TIMEOUT_RECEIVE)  Send "POST", url, data, timeoutEnd SubPrivate Sub Send(method As String, url As String, data As String, Optional timeout As Long)  On Error GoTo HTTP_error  If m_isRunning Then    Me.Cancel  End If  RaiseEvent Started  Set m_xhr = New MSXML2.ServerXMLHTTP60  m_xhr.OnReadyStateChange = Me  m_xhr.setTimeouts TIMEOUT_RESOLVE, TIMEOUT_CONNECT, TIMEOUT_SEND, timeout  m_isRunning = True  m_xhr.Open method, url, True  m_xhr.Send data  m_xhr.waitForResponse timeout  Exit SubHTTP_error:  If Err.Number = &H80072EE2 Then    Err.Clear    Me.Cancel    RaiseEvent TimedOut("Request timed out after " & timeout & "ms.")    Resume Next  Else    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext  End IfEnd Sub' Note: the default method must be public or it won't be recognizedPublic Sub OnReadyStateChange()Attribute OnReadyStateChange.VB_UserMemId = 0  If m_xhr.ReadyState = ReadyState.XHR_COMPLETED Then    m_isRunning = False    RaiseEvent Stopped    ' TODO implement 301/302 redirect support    If m_xhr.Status >= 200 And m_xhr.Status < 300 Then      RaiseEvent Success(m_xhr.responseText, m_xhr.Status)    Else      RaiseEvent Error(m_xhr.responseText, m_xhr.Status, m_xhr)    End If  End IfEnd Sub

Note the line m_xhr.OnReadyStateChange = Me, which assigns the AjaxRequest instance itself as the event handler, as made possible by marking OnReadyStateChange() as the default method.

Be aware that if you make changes to OnReadyStateChange() you need to go through the export/modify/re-import routine again since the VBA IDE does not save the "default method" attribute.

The class exposes the following interface

• Methods:
  • HttpGet(url As String, [timeout As Long])
  • HttpPost(url As String, data As String, [timeout As Long])
  • Cancel()
• Properties
  • IsRunning As Boolean
• Events
  • Started()
  • Stopped()
  • Success(data As String, serverStatus As String)
  • Error(data As String, serverStatus As String, xhr As MSXML2.ServerXMLHTTP)
  • TimedOut(message As String)

Use it in another class module, for example in a user form, with WithEvents:

Option ExplicitPrivate WithEvents ajax As AjaxRequestPrivate Sub UserForm_Initialize()  Set ajax = New AjaxRequestEnd SubPrivate Sub CommandButton1_Click()  Me.TextBox2.Value = ""  If ajax.IsRunning Then    ajax.Cancel  Else    ajax.HttpGet Me.TextBox1.Value, 1000  End IfEnd SubPrivate Sub ajax_Started()  Me.Label1.Caption = "Running" & Chr(133)  Me.CommandButton1.Caption = "Cancel"End SubPrivate Sub ajax_Stopped()  Me.Label1.Caption = "Done."  Me.CommandButton1.Caption = "Send Request"End SubPrivate Sub ajax_TimedOut(message As String)  Me.Label1.Caption = messageEnd SubPrivate Sub ajax_Success(data As String, serverStatus As String)  Me.TextBox2.Value = serverStatus & vbNewLine & dataEnd SubPrivate Sub ajax_Error(data As String, serverStatus As String, xhr As MSXML2.ServerXMLHTTP)  Me.TextBox2.Value = serverStatusEnd Sub

Make enhancements as you see fit. The AjaxRequest class was merely a byproduct of answering this question.