Estoy usando el objeto MSXML2.ServerXMLHTTP60 enviar la solicitud a webservice; con este objeto, puedo acelerar la velocidad de carga de datos por asincrónica método y evitar bloqueos de la pantalla de Excel (no responde). Pero, todavía estoy un problema al webservice de respuesta durante mucho tiempo, fuera de ServerXMLHTTP60 configuración de tiempo de espera, la función de solicitud estaba en silencio, no puedo coger error de tiempo de espera. En otra pregunta, @osknows sugiere el uso de xmlhttp status = 408 para la captura de error de tiempo de espera, pero no funciona para mí.

He cocinado un archivo de prueba, usted puede descargar aquí. Abrir fuente de VBA por la prensa Atl + F8, verá módulo de clase CXMLHTTPHandler, que he copiado de esta guía

    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

Cómo VBA captura de solicitud de tiempo de espera error?

Muchas gracias por tu ayuda!

OriginalEl autor Davuz | 2012-07-23

1 Comentario

  1. 16

    Hay varias complicaciones aquí.

    1. MSXML2.ServerXMLHTTP no exponer a COM-utilizable eventos. Por lo tanto, no es fácilmente posible crear una instancia de un objeto utilizando WithEvents y adjúntelo a su OnReadyStateChange evento.

      El evento está ahí, pero el estándar de VBA manera de manejar no funciona.
    2. El módulo que podría manejar el evento no puede ser creado utilizando el IDE VBA.
    3. Usted necesita llamar a waitForResponse() cuando se utiliza peticiones asíncronas (además de llamar a setTimeouts()!)
    4. No hay timeout evento. Los tiempos de espera son lanzados como un error.

    Para resolver el problema #1:

    Generalmente una VBA módulo de clase (también se aplica a los formularios de usuario o la hoja de cálculo módulos) permite hacer esto:

    Private WithEvents m_xhr As MSXML2.ServerXMLHTTP

    así se puede definir un controlador de eventos como este:

    Private Sub m_xhr_OnReadyStateChange()
      ' ...
    End Sub

    No es así con MSXML2.ServerXMLHTTP. Haciendo esto se traducirá en una de Microsoft Visual Basic Error de Compilación: «el Objeto no de origen de la automatización de los acontecimientos».

    Al parecer, el caso es que no se exportan para COM uso. Hay una forma de evitar esto.

    La firma para onreadystatechange lee

    Property onreadystatechange As Object

    Así que usted puede asignar un objeto. Podríamos crear un módulo de clase con un onreadystatechange método y asignar como este:

    m_xhr.onreadystatechange = eventHandlingObject

    Sin embargo, esto no funciona. onreadystatechange espera un objeto y cada vez que se desencadena el evento, el objeto se llama, no es el método que hemos definido. (Para el ServerXMLHTTP ejemplo no hay forma de saber qué método definido por el usuario eventHandlingObject tenemos la intención de utilizar como controlador de eventos).

    Necesitamos un objeto que se puede llamar, es decir, un objeto con un método predeterminado (todos los objetos COM pueden tener exactamente una).

    (Por ejemplo: Collection objetos se puede llamar, se puede decir myCollection("foo") que es una abreviación de myCollection.Item("foo").)

    Para resolver el problema #2:

    Necesitamos un módulo de clase con una propiedad predeterminada. Lamentablemente, estos no pueden ser creados usando el IDE VBA, pero usted puede crear mediante un editor de texto.

    • preparar el módulo de clase que contiene un onreadystatechange función en el IDE VBA
    • exportarlo a un .cls archivo a través de clic derecho
    • abierto que en un editor de texto y agregue la siguiente línea debajo de la onreadystatechange firma:

      Attribute OnReadyStateChange.VB_UserMemId = 0
    • retire el original del módulo de clase y volver a importar desde archivo.

    Esto marcará el método modificado como Default. Usted puede ver un pequeño punto azul en el Examinador de Objetos (F2), que marca el método predeterminado:

    Cómo VBA captura de solicitud de tiempo de espera error?

    Así que cada vez que el objeto se llama, en realidad la OnReadyStateChange método es llamado.

    Para resolver el problema #3:

    Simplemente llame waitForResponse() después de send().

    m_xhr.Send
    m_xhr.waitForResponse timeout

    En caso de un tiempo de espera: Si usted no llama a este método, la solicitud simplemente nunca se devuelve. Si no, se produce un error después de timeout milisegundos.

    Para resolver el problema #4:

    Necesitamos utilizar un On Error controlador que coge el error de tiempo de espera y la transforma en un evento, para una mayor comodidad.

    Poniendo todo junto

    Aquí es un VB módulo de clase me escribió que se ajusta y controla una MSXML2.ServerXMLHTTP objeto. Guardar como AjaxRequest.cls y la importación en su proyecto:

    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

    Nota la línea de m_xhr.OnReadyStateChange = Me, que asigna a la AjaxRequest instancia como el controlador de eventos, como se hizo posible mediante el marcado de OnReadyStateChange() como el método por defecto.

    Ser conscientes de que si usted hace cambios a OnReadyStateChange() que usted necesita para ir a través de la exportación/modificar/re-importación de rutina de nuevo desde el IDE VBA no guardar el «método predeterminado» atributo.

    La clase expone la siguiente interfaz

    • Métodos:
      • HttpGet(url As String, [timeout As Long])
      • HttpPost(url As String, data As String, [timeout As Long])
      • Cancel()
    • Propiedades
      • IsRunning As Boolean
    • Eventos
      • Started()
      • Stopped()
      • Success(data As String, serverStatus As String)
      • Error(data As String, serverStatus As String, xhr As MSXML2.ServerXMLHTTP)
      • TimedOut(message As String)

    Utilizarla en otro módulo de clase, por ejemplo en un formulario de usuario, con 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

    Hacer mejoras como mejor le parezca. El AjaxRequest clase era simplemente un subproducto de responder a esta pregunta.

    FWIW: Probablemente habría sido más fácil usar un WinHttp.WinHttpRequest objeto en lugar de golpear MSXML2.ServerXMLHTTP. WinHttpRequest expone todos los eventos en el derecho de la moda, pero hay que ir.
    Muchas gracias! Los últimos días, estoy estrés con alguna otra de las tareas, entonces todavía tengo comprobado esta pregunta; el día de hoy estoy muy contento con la respuesta, es muy detallada. Voy a probarlo a principios de tomorrow mañana. Ahora es muy tarde en la noche
    Eso es todo-derecho. Yo no quería empujar, pero me estaba empezando a preguntarse si responde en lo absoluto. Tal vez yo era demasiado impaciente. 😉
    😀 Oh,tengo que decir que estoy muy ocupado así que forget para comprobar la respuesta. Ahora estoy tratando de que
    AjaxRequest funcionan a la perfección! Gracias de nuevo!

    OriginalEl autor Tomalak

Dejar respuesta

Please enter your comment!
Please enter your name here