お分かりになる方がおりましたら、アドバイスをお願い致します。
WinHttpRequestオブジェクトを生成して、HTTP通信を行うクラスモジュールがあるのですが、下記の赤文字の部分(Send)でエラー(Err文言:無効または認識されない応答をサーバーが返しました)が発生して困っています。
そして、自宅環境で自宅するとエラーは起こらないのですが、会社環境で実行すると時々エラーが発生する(毎回ではない。クラスの用途は同じなのに)という状況です。
いろいろと確認したところ、WinHTTPプロキシが関係していそうなことが分かっています。
と言うのもエラー発生後に以下を行って、再実行するとほとんどの場合、改善するからです。
・Edgeブラウザを終了する
・PowerShellでWinHTTPプロキシ設定を確認するコマンドを実行する(netsh winhttp show proxy)
以上よりSendコマンド実行前にWinHTTPプロキシ設定を認識させるコードを追加すればよいのかなと想像しています(WinHTTPプロキシ設定はされているが、何かの拍子に認識されなくなっているため、再認識させる?)。
何かよい方法がありましたら、ご教授いただけますと幸いです。
よろしくお願い致します。
<クラスモジュール抜粋>
---------------------------------------------
Option Explicit
Public HttpReq As Object
Public Cookie As String
Public RspTxt As String
Public AllRspHeaders As String
Const REQ_INTVL_MS As Long = 1000 ' リクエストの送信間隔(ミリ秒)
Const RSP_STS_SUCC As Long = 200 ' ステータスコード(成功)
Private Sub Class_Initialize()
Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
End Sub
Private Sub Class_Terminate()
Set HttpReq = Nothing
End Sub
Public Function SendReq(ByVal url As String, _
Optional loginData As Variant = vbEmpty) As Boolean
Sleep REQ_INTVL_MS ' 標準モジュールで定義したスリープ関数でリクエスト間隔を空ける
On Error GoTo HasErr
With HttpReq
If loginData = vbEmpty Then ' リクエストメソッドを設定
.Open "GET", url, False
Else
.Open "POST", url, False
End If
Call SetRequestHeader ' リクエストヘッダーを設定
If loginData <> vbEmpty Then
loginData = MakeRequestBody(loginData) ' リクエストボディ(ログイン情報)を生成する関数
End If
.Send loginData
DoEvents
If .Status <> RSP_STS_SUCC Then GoTo HasErr
RspTxt = .responseText
AllRspHeaders = .getAllResponseHeaders
Cookie = .GetResponseHeader("Set-Cookie")
End With
SendReq = True
Exit Function
HasErr:
SendReq = False
End Function
Private Sub SetRequestHeader()
With HttpReq
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Connection", "Keep-Alive"
.SetRequestHeader "Accept-encoding", "identity"
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.82 Safari/537.36"
If Cookie <> vbNullString Then
.SetRequestHeader "Cookie", Encode(Cookie)
End If
End With
End Sub