0

以下のコードを使用して、HTTP+JSON Web サービスへの POST および GET 要求を実行しています。Win7 および Excel 2013 ではすべてが完全に動作します。Windows XP および Excel 2003 でのテストでは、GET は正常に機能しましたが (要求本文に JSON オブジェクトが含まれています)、POST は正常に機能しませんでした。回線経由で送信されるはずの JSON データは完璧に見えますが、サーバー側では受信されず、クライアント コードはエラーを報告しません。残念ながら、実際に何が送信されているかを確認するためにスニファーをインストールすることはできません。MSXML2.ServerXMLHTTP オブジェクトを使用するようにコードを変更すると、問題なく動作します (これが解決策になります)。誰もこの問題の経験がありますか? WinHttpRequest で機能しない理由を理解しようとしています...

'Copied from https://coderwall.com/p/pbxsyw/vba-web-requests
Private Function MakeWebRequest(Method As String, Url As String, PostData As String) As Boolean
    ' make sure to include the Microsoft WinHTTP Services in the project
    ' tools -> references -> Microsoft WinHTTP Services, version 5.1
    ' http://www.808.dk/?code-simplewinhttprequest
    ' http://msdn.microsoft.com/en-us/library/windows/desktop/aa384106(v=vs.85).aspx
    ' http://www.neilstuff.com/winhttp/

    On Error GoTo ErrorHandler:

    ' create the request object
    Set mobjWebReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    ' set timeouts
    ' http://msdn.microsoft.com/en-us/library/windows/desktop/aa384061(v=vs.85).aspx
    ' SetTimeouts(resolveTimeout, ConnectTimeout, SendTimeout, ReceiveTimeout)
    mobjWebReq.SetTimeouts 60000, 60000, 60000, 60000

    If Not LastUsedUrlMonitor Is Nothing Then
        LastUsedUrlMonitor.Value2 = Url
    End If

    ' make the request, http verb (method), url, false to force syncronous
    ' open(http method, absolute uri to request, async (true: async, false: sync)
    mobjWebReq.Open Method, Url, False

    ' handle post content type
    If Method = "POST" Then
        mobjWebReq.SetRequestHeader "Content-type", _
          "application/json"
        If Not LastHttpBodySendMonitor Is Nothing Then
            LastHttpBodySendMonitor.Value2 = PostData
        End If
    End If

    ' set WinHttpRequestOption enumerations
    ' http://msdn.microsoft.com/en-us/library/windows/desktop/aa384108(v=vs.85).aspx

    ' set ssl ignore errors
    '   13056: ignore errors
    '   0: break on errors
    mobjWebReq.Option(4) = 13056

    ' set redirects
    mobjWebReq.Option(6) = True

    ' allow http to redirect to https
    mobjWebReq.Option(12) = True

    ' send request
    ' send post data, should be blank for a get request
    mobjWebReq.Send PostData

    MakeWebRequest = True

    If Not LastHttpBodyReceivedMonitor Is Nothing Then
        LastHttpBodyReceivedMonitor.Value2 = mobjWebReq.Status & ": " & mobjWebReq.StatusText & ", Body: " & mobjWebReq.ResponseText
    End If

    Exit Function

ErrorHandler:
    Select Case Err.Number
        Case &H80072EFD
            MsgBox "Connection to URL: " & Chr(13) & Url & Chr(13) & "failed: " & Err.Description
        Case Else
            MsgBox Err.Number & Chr(13) & Err.Description
    End Select
    Err.Clear
    'Set mobjWebReq = Nothing
    MakeWebRequest = False
    Exit Function
End Function
4

1 に答える 1