Asynchronous HTTP POST Request in MS Access

问题:

I am using Asynchronous HTTP Request Class in my access project. The author has only added GET. Hence I am trying to add POST functionality to the class.

The following code I added to the Class

Public Sub PostRequest(serviceURL As Variant, Optional apiBody As String)
On Error GoTo Sub_Err

    Set m_oXmlHttp = New MSXML2.XMLHTTP60

    m_oXmlHttp.Open "POST", serviceURL, True

    'this sets the onreadystatechange call back to an instance of this object
    'which causes the default method HandleResponse to be called when the ready
    'state changes
    m_oXmlHttp.onreadystatechange = Me
    m_oXmlHttp.send apiBody


'Error Catching
Sub_Exit:
    Exit Sub
Sub_Err:
    MsgBox Error$
    Resume Sub_Exit
End Sub

When calling the above sub, I am suing the below code in my form.

Private WithEvents oAHlogin As clsAsyncHTTP  


Private Sub PostLoginData()
    Dim apiURL, apiBody As String
    apiURL = "myurl"
    apiBody = "mybody"

    Set oAHlogin = New clsAsyncHTTP                                     
    oAHlogin.PostRequest apiURL, apiBody       '*This is where the execution stops*.

End Sub


Private Sub oAHlogin_ResponseReady(ByVal ready As Boolean)  
    If ready Then
        Debug.Print oAHlogin.GetReponseText
    End If
End Sub

See above line, where I have mentioned This is where execution stops. Any help is appreciated. I am relatively new to programming. Am I calling the sub incorrectly? Is the parenthesis missing?

I was able to execute GET correctly as shown by author of the class. The POST which I added, does not work

Edit 1: Reply to Gord Thompson, making this Q as duplicate: The Question # 1463635 is for ASP, I am asking for Access in VBA which are completely different things.

Edit 2: I have added following references in my Access project.

回答1:

It doesn't matter if you are "post"ing or "GET"ing. There are few things you need to understand before making this happen.

1. MS Access vba is single threadded, so parallel execution or threadded execution is not possible except using external DLLs or little available hacks.
2. In order to achieve "Asynchronous HTTP Requests" or in other words, to tell the VBA not to wait for HTTP reply, you need a little hack on the callback class.

The process flow is as this:

1. Create your HTTP request
2. add all parameters and everything else
3. assign a callback function
4. Send/Open the MSXML2.XMLHTTP with [varAsyn]=True
5. let the vba continue work on the other code, once http reply is received, the callback class will fire an event.

Important: The callback function will be a class and that class needs the hack.

[STEP1: Preparing the callback class]

Create new Class module in your VBA, call it HTTP_HANDLER_CLASS with following code:

Option Compare Database
Option Explicit
Dim m_xmlHttp As MSXML2.XMLHTTP

Public Sub Initialize(ByRef xmlHttpRequest As MSXML2.XMLHTTP)
   Set m_xmlHttp = xmlHttpRequest
End Sub

Sub OnReadyStateChange()
   If m_xmlHttp.ReadyState = 4 Then
      If m_xmlHttp.status = 200 Then
         Debug.Print m_xmlHttp.responseText
      Else
         'Error happened
     End If
   End If
End Sub

[STEP2: modifying/hacking the call-back class]

1. Now export the class and save it in your desktop as HTTP_HANDLER_CLASS.cls
2. Open the exported class in any text editing tool
3. Add: "Attribute OnReadyStateChange.VB_UserMemId = 0" just below the sub "Sub OnReadyStateChange()"
4. Go back to VBA and import the class (overwrite or delete existing)

This will make the OnReadyStateChange() as the default function which is what we wanted to have and so far, you've done the most important part:

[Step 3: sending requests this example uses SOAP action] Assume a web-service "CallingServiceName" is available to you which takes two parameters iEmail, iPassword and returns a string if the login was success or not.

Module level variable:
Public xmlHttpRequest As MSXML2.XMLHTTP

Public Function HTTP_TEST()

On Error GoTo FailedState
If Not xmlHttpRequest Is Nothing Then Set xmlHttpRequest = Nothing

Dim MyXmlHttpHandler As HTTP_HANDLER_CLASS 'our hacked call back class
Set xmlHttpRequest = New MSXML2.XMLHTTP

Dim sURL As String
Dim sEnv As String


sURL = "http://mydomain.co.uk/mywebsite/myservices.asmx?op=CallingServiceName"

sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"
sEnv = sEnv & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
sEnv = sEnv & "  <soap:Body>"
sEnv = sEnv & "    <CallingServiceName xmlns=""http://mydomain.co.uk/"">"
sEnv = sEnv & "      <iEmail>username</iEmail>"
sEnv = sEnv & "      <iPassword>mypassword</iPassword>"
sEnv = sEnv & "    </CallingServiceName>"
sEnv = sEnv & "  </soap:Body>"
sEnv = sEnv & "</soap:Envelope>"

' Now create an instance of our call-back class
Set MyXmlHttpHandler = New HTTP_HANDLER_CLASS 
MyXmlHttpHandler.Initialize xmlHttpRequest

   ' Now attach the call-back class to our request, so whenever the request's state changes, callback classs default function will fire.
    xmlHttpRequest.OnReadyStateChange = MyXmlHttpHandler

   ' seal the envelop and send it
    xmlHttpRequest.Open "Post", sURL, True ' here set varAsyn=true 
    xmlHttpRequest.setRequestHeader "Host", "mydomain.co.uk"
    xmlHttpRequest.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
    xmlHttpRequest.setRequestHeader "soapAction", "http://mydomain.co.uk/CallingServiceName"
    xmlHttpRequest.Send sEnv

    Debug.Print "Controller finished job" ' this is for you to realize vba will continue to work, the http result will be fired whenever the onstateChanges.

   Exit Function

FailedState:
    'MsgBox err.Number & ": " & err.description
End Function

[Result]

oh btw, Microsoft XML v3 is enough for this.

Above example uses SOAP version but you can use any method. Please let me know if this has helped.

回答2:

You need to set headers - At a minimum you need to add this line to your class, before you call .Send

m_oXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

回答3:

After messing around with the code a bit more I found that when making an asynchronous POST there were a couple of subtle changes required to the code in the answer to the question I previously marked as duplicate. This is the code that ultimately worked for me:

' VBA project reference required:
'     Microsoft XML, v6.0

Dim postData As String
postData = "word1=hello&word2=world"

Dim objXmlHttp As New MSXML2.XMLHTTP
objXmlHttp.Open "POST", "http://localhost:8080/postTest.php", True
objXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objXmlHttp.setRequestHeader "Content-Length", Len(postData)
objXmlHttp.send postData
Set objXmlHttp = Nothing