以下のコードを使用して、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