I’m using object MSXML2.ServerXMLHTTP60 send request to webservice; with this object, I can speed up data loading by asynchronous method and avoid lockups Excel screen (not responding). But, I’m still have a problem when webservice response for a long time, out of ServerXMLHTTP60 timeout setting, the request function was silently, I cannot catch timeout error. At another question, @osknows suggests using
xmlhttp status = 408 to catching timeout error, but it doesn’t work for me.
If m_xmlHttp.readyState = 4 Then If m_xmlHttp.Status = 200 Then MsgBox m_xmlHttp.responseText ElseIf m_xmlHttp.Status = 408 Then 'Debug never run to here? MsgBox "Request timeout" Else 'Error happened End If End If
How to VBA catch request timeout error?
Thank for your help!
There are several complications here.
MSXML2.ServerXMLHTTPdoes not expose COM-usable events. Therefore it is not easily possible to instantiate an object using
WithEventsand attach to its
The event is there, but the standard VBA way to handle it does not work.
- The module that could handle the event cannot be created using the VBA IDE.
- You need to call
waitForResponse()when you use asynchronous requests (additionally to calling
- There is no
timeoutevent. 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
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).
Collection objects are callable, you can say
myCollection("foo") which is a shorthand for
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
onreadystatechangefunction in the VBA IDE
- export it to a
.clsfile via right click
- open that in a text editor and add the following line beneath the
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:
m_xhr.Send m_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
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 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "AjaxRequest" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private m_xhr As MSXML2.ServerXMLHTTP Attribute m_xhr.VB_VarHelpID = -1 Private m_isRunning As Boolean ' default timeouts. TIMEOUT_RECEIVE can be overridden in request Private Const TIMEOUT_RESOLVE As Long = 1000 Private Const TIMEOUT_CONNECT As Long = 1000 Private Const TIMEOUT_SEND As Long = 10000 Private Const TIMEOUT_RECEIVE As Long = 30000 Public 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 = 4 End Enum Public Sub Class_Terminate() Me.Cancel End Sub Public Property Get IsRunning() As Boolean IsRunning = m_isRunning End Property Public Sub Cancel() If m_isRunning Then m_xhr.abort m_isRunning = False RaiseEvent Stopped End If Set m_xhr = Nothing End Sub Public Sub HttpGet(url As String, Optional timeout As Long = TIMEOUT_RECEIVE) Send "GET", url, vbNullString, timeout End Sub Public Sub HttpPost(url As String, data As String, Optional timeout As Long = TIMEOUT_RECEIVE) Send "POST", url, data, timeout End Sub Private 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 Sub HTTP_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 If End Sub ' Note: the default method must be public or it won't be recognized Public 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 If End 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
HttpGet(url As String, [timeout As Long])
HttpPost(url As String, data As String, [timeout As Long])
IsRunning As Boolean
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
Option Explicit Private WithEvents ajax As AjaxRequest Private Sub UserForm_Initialize() Set ajax = New AjaxRequest End Sub Private Sub CommandButton1_Click() Me.TextBox2.Value = "" If ajax.IsRunning Then ajax.Cancel Else ajax.HttpGet Me.TextBox1.Value, 1000 End If End Sub Private Sub ajax_Started() Me.Label1.Caption = "Running" & Chr(133) Me.CommandButton1.Caption = "Cancel" End Sub Private Sub ajax_Stopped() Me.Label1.Caption = "Done." Me.CommandButton1.Caption = "Send Request" End Sub Private Sub ajax_TimedOut(message As String) Me.Label1.Caption = message End Sub Private Sub ajax_Success(data As String, serverStatus As String) Me.TextBox2.Value = serverStatus & vbNewLine & data End Sub Private Sub ajax_Error(data As String, serverStatus As String, xhr As MSXML2.ServerXMLHTTP) Me.TextBox2.Value = serverStatus End Sub
Make enhancements as you see fit. The
AjaxRequest class was merely a byproduct of answering this question.