如何VBA捕获请求超时错误？ [英] How to VBA catch request timeout error?

查看：955
本文介绍了如何VBA捕获请求超时错误？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在使用对象 MSXML2.ServerXMLHTTP60 发送请求到webservice;有了这个对象，我可以通过异步方法加速数据加载，并避免锁定Excel屏幕（不响应）。但是，我还是有一个问题，当webservice响应很长时间，出于ServerXMLHTTP60超时设置，请求功能默认，我无法捕获超时错误。在另一个问题，@osknows建议使用 xmlhttp status = 408 以捕获超时错误，但对我来说不起作用。



我已经准备好了一个测试文件，您可以在这里下载。您可以通过按 Atl + F8 打开VBA源，您将看到从 CXMLHTTPHandler http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/ =nofollow noreferrer>本指南 

 如果m_xmlHttp.readyState = 4然后
如果m_xmlHttp.Status = 200然后
 MsgBox m_xmlHttp.responseText 
 ElseIf m_xmlHttp.Status = 408然后调试从不跑到这里？ 
 MsgBox请求超时
 Else 
'发生错误
结束如果
结束如果

如何VBA捕获请求超时错误？



感谢您的帮助！

解决方案

这里有几个并发症。


  1. MSXML2.ServerXMLHTTP 不会公开COM可用的事件。因此，使用 WithEvents 实例化对象是不容易的，并附加到其 OnReadyStateChange 事件。

    事件在那里，但处理它的标准VBA方法不起作用。

  2. 无法使用VBA IDE创建可处理该事件的模块。

  3. 您需要致电 waitForResponse（） 当您使用异步请求（另外调用 setTimeouts（）！）

  4. 没有超时事件。超时将作为错误引发。

要解决问题＃1：



通常，VBA类模块（也适用于用户表单或工作表模块）允许您执行此操作：

  Private WithEvents m_xhr作为MSXML2.ServerXMLHTTP

所以你可以定义一个这样的事件处理程序：

  Private Sub m_xhr_OnReadyStateChange（）
'... 
 End Sub

不是与 MSXML2.ServerXMLHTTP 。执行此操作将导致Microsoft Visual Basic编译错误：对象不会自动生成事件。



显然，事件未导出为COM使用。这有一个办法。



onreadystatechange 的签名读取

 属性onreadystatechange作为对象

所以你可以分配对象。我们可以使用 onreadystatechange 方法创建一个类模块，并分配如下：

  m_xhr.onreadystatechange = eventHandlingObject

但是，这不起作用。 onreadystatechange 期望一个对象，每当事件触发时，对象本身被调用，而不是我们定义的方法。 （对于 ServerXMLHTTP 实例，无法知道用户定义的 eventHandlingObject 的方法，我们打算用作事件处理程序）。



我们需要一个可调用对象，即具有默认方法的对象（每个COM对象都可以只有一个）。

（例如：集合对象可调用，您可以说 myCollection（foo）这是 myCollection.Item（foo）的缩写。）



要解决问题＃2：



我们需要一个带有默认属性的类模块。不幸的是，这些无法使用VBA IDE创建，但您可以使用文本编辑器创建它们。




  • 准备在VBA IDE中包含 onreadystatechange 函数的类模块

  • 通过右键单击

  • 将其导出到 .cls 文件，在文本编辑器和在 onreadystatechange 签名之下添加以下行：

    属性OnReadyStateChange.VB_UserMemId = 0

  • 删除原始类模块，并从文件重新导入。



这将标记修改方法为 Default 。您可以在对象浏览器（F2）中看到一个小点，标示默认方法：





所以每次调用该对象时，实际上 OnReadyStateChange 方法被调用。



要解决问题＃3：



只需在 send（）之后调用 waitForResponse（）。

  m_xhr.Send 
 m_xhr.waitForResponse timeout

如果超时：如果没有调用此方法，则该请求根本不会返回。如果你这样做，在 timeout之后抛出一个错误。毫秒。



要解决问题＃4： / strong>



我们需要使用 On Error 处理程序，捕获超时错误并将其转换为事件为了方便起见，



将它们放在一起



这是一个VB类模块我写了包裹并处理一个 MSXML2.ServerXMLHTTP 对象。将其保存为 AjaxRequest.cls 并将其导入到您的项目中：

  VERSION 1.0 CLASS 
 BEGIN 
 MultiUse = -1'True 
 END 
属性VB_Name =AjaxRequest
属性VB_GlobalNameSpace = False 
属性VB_Creatable = False 
属性VB_PredeclaredId = False 
属性VB_Exposed = False 
选项显式
 
私有m_xhr作为MSXML2.ServerXMLHTTP 
属性m_xhr.VB_VarHelpID = -1 
私有m_isRunning As Boolean 
 
'默认超时。 TIMEOUT_RECEIVE可以在请求中被覆盖
 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 
 
公共事件已启动（）
公共事件Stopped（）
公共事件成功（数据As String，serverStatus As String）
公共事件错误（数据As String， serverStatus As String，xhr as MSXML2.ServerXMLHTTP）
公共事件TimedOut（消息As String）
 
私有枚举ReadyState 
 XHR_UNINITIALIZED = 0 
 XHR_LOADING = 1 
 XHR_LOADED = 2 
 XHR_INTERACTIVE = 3 
 XHR_COMPLETED = 4 
结束枚举
 
公共子类Class_Terminate（）
 Me.Cancel 
结束子
 
公共属性获取IsRunning（）作为布尔值
 IsRunning = m_isRunning 
结束属性
 
公共子取消（）
如果m_isRunning Then 
 m_xhr.abort 
 m_isRunning = False 
 RaiseEvent已停止
结束如果
设置m_xhr = Nothing 
 End Sub 
 
 Public Sub HttpGet（url As String，可选的timeout As Long = TIMEOUT_RECEIVE）
发送GET，url， vbNullString，timeout 
 End Sub 
 
 Public Sub HttpPost（url As String，data As String，可选timeout As Long = TIMEOUT_RECEIVE）
发送POST，url，data，timeout 
 End Sub 
 
私有子发送（方法As String，url As String，data As String，可选超时为长）
错误GoTo HTTP_error 
 
如果m_isRunning然后
 Me.Cancel 
结束If 
 
 RaiseEvent Started 
 
设置m_xhr =新建MSXML2.ServerXMLHTTP60 
 
 m_xhr.OnReadyStateChange = Me 
 m_xhr.setTimeouts TIMEOUT_RESOLVE，TIMEOUT_CONNECT，TIMEOUT_SEND，超时
 
 m_isRunning = True 
 m_xhr.Open方法，url，True 
 m_xhr.Send数据
 m_xhr.waitForResponse timeout 
 
退出子
 
 HTTP_error：
如果Err.Number =& H80072EE2然后
 Err.Clear 
 Me.Cancel 
 RaiseEvent TimedOut（请求超时&超时& ms。）
简历Next 
 Else 
 Err.Raise Err.Number，Err.Source，Err.Description，Err.HelpFile，Err.HelpContext 
 End If 
 End Sub 
 
'注意：默认方法必须是public或不会被识别
 Public Sub OnReadyStateChange（）
属性OnReadyStateChange.VB_UserMemId = 0 
如果m_xhr.ReadyState = ReadyState.XHR_COMPLETED然后
 m_isRunning = False 
 RaiseEvent已停止
 
'TODO实施301/302重定向支持
 
如果m_xhr。状态> = 200和m_xhr.Status< 300然后
 RaiseEvent Success（m_xhr.responseText，m_xhr.Status）
 Else 
 RaiseEvent错误（m_xhr.responseText，m_xhr.Status，m_xhr）
结束如果
结束如果
 End Sub

请注意行 m_xhr.OnReadyStateChange = Me ，它将AjaxRequest实例本身分配为事件处理程序，通过将 OnReadyStateChange（）标记为默认值方法。



请注意如果您对 OnReadyStateChange（）进行更改再次导出/重新导入例程，因为VBA IDE不保存default method属性。



该类公开了以下界面。 p>


  • 方法：


    • HttpGet（url As字符串，[超时长]）

    • HttpPost（url As String，data As String，[timeout As Long] code>

    • 取消（）


      • 属性


        • IsRunning As Boolean

      • 事件


        • Started（） / code>

        • Stopped（）

        • 成功（数据As String，serverStatus As String）

        • 错误（数据As String，serverStatus As String，xhr as MSXML2.ServerXMLHTTP）

        • TimedOut（邮件As String）

        / li>


      在另一个类模块中使用它，例如用户窗体中的 WithEvents ：

        Option Explicit 
       
       Private WithEvents ajax As AjaxRequest 
       
       Private Sub UserForm_Initialize（）
      设置ajax =新建AjaxRequest 
       End Sub 
       
       Private Sub CommandButton1_Click（）
       Me.TextBox2.Value = 
       
      如果ajax.IsRunning然后
       ajax.Cancel 
       Else 
       ajax.HttpGet Me.TextBox1.Value，1000 
      结束如果
       End Sub 
       
       Private Sub ajax_Started（）
       Me.Label1.Caption =Running& Chr（133）
       Me.CommandButton1.Caption =取消
       End Sub 
       
      私有子ajax_Stopped（）
       Me.Label1.Caption =完成。 
       Me.CommandButton1.Caption =发送请求
       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&数据
       End Sub 
       
       Private Sub ajax_Error（data As String，serverStatus As String，xhr as MSXML2.ServerXMLHTTP）
       Me.TextBox2.Value = serverStatus 
       End Sub

      根据您的需要进行增强。 AjaxRequest 类只是回答这个问题的副产品。


      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.

      I've prepaired a test file, you can download at here. Open VBA source by press Atl + F8, you will see class module CXMLHTTPHandler, that I copied from this guide

          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.

      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.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 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 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

      • 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 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.

      这篇关于如何VBA捕获请求超时错误？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Office最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆