Wie Sie VBA-catch-request timeout der Fehler?

Gibt es mehrere Komplikationen hier.

1. MSXML2.ServerXMLHTTP nicht aussetzen COM-Veranstaltungen nutzbar. Daher ist es nicht einfach möglich, instanziieren Sie ein Objekt mit WithEvents und hängen Sie es an den OnReadyStateChange Veranstaltung.
   
   Das Ereignis ist da, aber die standard-VBA-Weg zu handhaben, funktioniert es nicht.
2. Das Modul, das könnte Griff das Ereignis kann nicht erstellt werden, mithilfe der VBA-IDE.
3. Die Sie anrufen waitForResponse() wenn Sie asynchrone Anfragen (zusätzlich zum Aufruf setTimeouts()!)
4. Es gibt keine timeout Veranstaltung. Timeouts ausgelöst werden, wie ein Fehler.

Zu beheben Problem #1:

In der Regel ein VBA-Klassenmodul (gilt auch für Benutzer Formulare oder Arbeitsblatt-Module) ermöglicht es Ihnen, dies zu tun:

Private WithEvents m_xhr As MSXML2.ServerXMLHTTP

so können Sie definieren einen event-handler wie diese:

Private Sub m_xhr_OnReadyStateChange()
  ' ...
End Sub

Nicht so mit MSXML2.ServerXMLHTTP. Dadurch wird Ergebnis in ein Microsoft Visual Basic Kompilierungs-Fehler: "Objekt nicht source automation events".

Offenbar das Ereignis wird nicht exportiert, für die COM verwenden. Es gibt einen Weg, um dieses.

Die Signatur für onreadystatechange liest

Property onreadystatechange As Object

So ordnen Sie ein Objekt. Können wir erstellen ein Klassenmodul mit einer onreadystatechange - Methode und weisen wie diese:

m_xhr.onreadystatechange = eventHandlingObject

Jedoch, funktioniert dies nicht. onreadystatechange erwartet ein Objekt, und wenn das Ereignis ausgelöst wird, das Objekt sich genannt wird, und nicht die Methode, die wir definiert haben. (Für die ServerXMLHTTP Instanz gibt es keine Möglichkeit zu wissen, welche Methode der Benutzer-definierten eventHandlingObject wir beabsichtigen, zu verwenden, da der event-handler).

Brauchen wir ein callable Objekt, d.h. ein Objekt mit einem Standard-Methode (jeder COM-Objekt kann genau ein).

(Zum Beispiel: Collection Objekte aufrufbar sind, können Sie sagen myCollection("foo") ist eine Kurzform für myCollection.Item("foo").)

Zu beheben Problem #2:

Benötigen wir ein class-Modul mit einer default-Eigenschaft. Leider können diese nicht erstellt werden, mithilfe der VBA-IDE, aber Sie können erstellen Sie mit einem text-editor.

• bereiten Sie die Klasse Modul enthält eine onreadystatechange - Funktion in der VBA-IDE
• exportieren Sie es in ein .cls Datei über Rechtsklick
• öffnen, die in einem text-editor und fügen Sie die folgende Zeile unterhalb der onreadystatechange Signatur:
  
  Attribute OnReadyStateChange.VB_UserMemId = 0
• entfernen Sie die original-Klasse-Modul und re-import aus Datei.

Dieser Marke wird die geänderte Methode als Default. Sehen Sie einen kleinen blauen Punkt in der Objekt-Browser (F2), Marken, die die Standard-Methode:

Also jedes mal, wenn das Objekt aufgerufen wird, eigentlich die OnReadyStateChange - Methode aufgerufen wird.

Zu beheben Problem #3:

Rufen Sie einfach waitForResponse() nach send().

m_xhr.Send
m_xhr.waitForResponse timeout

Im Falle einer Zeitüberschreitung: Wenn Sie nicht diese Methode aufrufen, wird die Anfrage einfach nie zurück. Wenn du das getan hast, wird ein Fehler geworfen, nachdem timeout Millisekunden.

Zu beheben Problem #4:

Brauchen wir eine On Error handler, fängt die timeout-Fehler auf und transformiert es in eine Veranstaltung, für die Bequemlichkeit.

Setzen Sie alle zusammen

Hier ist ein VB-Klassenmodul habe ich geschrieben, dass Packungen und Griffe eine MSXML2.ServerXMLHTTP Objekt. Speichern Sie es als AjaxRequest.cls und importieren Sie es in Ihr Projekt:

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

Beachten Sie die Zeile m_xhr.OnReadyStateChange = Me Zuordnung der AjaxRequest Instanz sich als Ereignis-handler möglich gemacht durch die Kennzeichnung OnReadyStateChange() als die Standard-Methode.

Sich bewusst sein, dass wenn Sie änderungen an OnReadyStateChange() Sie brauchen durch zu gehen die exportieren/ändern/re-import-routine wieder kommen, da der VBA-IDE nicht speichern Sie die "Standard-Methode" Attribut.

Die Klasse stellt die folgende Schnittstelle

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

Verwenden Sie es in einer anderen Klasse, Modul, beispielsweise in einer user-form, mit 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

Ergänzungen vornehmen, wie Sie sehen, passen. Die AjaxRequest Klasse war lediglich ein Nebenprodukt der Beantwortung dieser Frage.