ループ内でオブジェクト 'IXMLHTTPRequest'のオープンが失敗する

Question

私のサーバーで約10秒間毎秒ファイルの存在をチェックしたいと思います。ファイルがある場合はダウンロードしてください。それはそこにはありません（404）まで、最大10回まで10秒以上広がります。 I VBAでない通常のコードを実行しますが、ここに行く..私は私のダウンロード機能があります。

Function DownloadFile(url As String, fileID As String) 

    ' Setup our path where we will save the downloaded file. 
    Dim fileSavePath As String 
    fileSavePath = Environ("USERPROFILE") & "\" & Environ("USERNAME") & "-123-" & fileID & ".xlsx" 

    ' Use Microsoft.XMLHTTP in order to setup a connection. 
    ' https://msdn.microsoft.com/en-us/library/ms535874(v=vs.85).aspx#methods 
    Dim WinHttpReq As Object 
    Set WinHttpReq = CreateObject("MSXML2.XMLHTTP") 
    ' Pass GET to the Open method in order to start the download of the file. 
    WinHttpReq.Open "GET", url, False ' method, http verb, async = false 

    ' Send our request: https://msdn.microsoft.com/en-us/library/ms536736(v=vs.85).aspx 
    WinHttpReq.send 

    ' Reset the url parameter to be the body of the response. 
    url = WinHttpReq.responseBody 

    ' WinHttpReq.Status holds the HTTP response code. 
    If WinHttpReq.Status = 200 Then 
     ' Setup an object to hold the binary stream of data (the file). 
     Set oStream = CreateObject("ADODB.Stream") 
     oStream.Open 
     ' Set type read only or not: https://msdn.microsoft.com/en-us/library/ms681553(v=vs.85).aspx 
     oStream.Type = 1 
     ' Write the binary data to WinHttpReq.responseBody 
     ' We can do this because we have confirmed a download via the response code (200). 
     oStream.Write WinHttpReq.responseBody 
     oStream.SaveToFile fileSavePath, 2 ' 2 = overwrites the existing file, 1 = will not. 
     ' We are done we the stream, close it. 
     oStream.Close 
     Debug.Print "File downloaded! File path: " & fileSavePath 
     DownloadFile = 1 
    End If 

    ' Handle if the file doesn't exist. 
    If WinHttpReq.Status = 404 Then 
     DownloadFile = 0 
    End If 

End Function 

をそして、私は10回まで、この関数を呼び出すサブあります

Sub Callee(url As String, fileID As String) 

    Dim i As Integer 
    i = 0 

    Do While i < 10 

     If DownloadFile(url, fileID) = 1 Then 
      Debug.Print "here" 
      i = 100 
     Else 
      Debug.Print fileID & " not found! Try number: " & i 
      i = i + 1 
      ' We didnt get the response we wanted, so we will wait one second and try again. 
      Application.Wait (Now + TimeValue("0:00:01")) 
     End If 

    Loop 

End Sub 

私のコードを私は404応答を受け取ったときに一度だけ実行されます。コードは再びループしようとしたときに私が取得：

私のコードはループを通って、一度だけ一度だけ実行し、なぜ私は理解していません。私はSet WinHttpReq = Nothingに私の関数の最後にガベージコレクションが何も処理されていない場合に備えて試みましたが、私はこの変数が自分の関数にスコープされていることに気付きました...

ありがとうございました。

Answer 1

申し訳ありませんが、この質問と回答は誤解を招きます。コードは、行urlはバイナリデータで満たされます

' Reset the url parameter to be the body of the response. 
url = WinHttpReq.responseBody 

のバグを有します。なぜあなたはこれをやっている？確かにByValを使用すると、毎回urlの新鮮なコピーを取得することを意味しますが、なぜこれを行うのですか？私はこの行をコメントアウトし、問題はなくなりました。

IMHOはMSXML2.XMLHTTPのインスタンス化とは関係なく、ガベージコレクションはurlが渡されただけで無効です。

Answer 2

Calleeの方法でWinHttpReqを作成し、このオブジェクトを使用してリクエストを送信してください。例：

Option Explicit 

Sub Callee(url As String, fileID As String) 

    ' Setup our path where we will save the downloaded file. 
    Dim fileSavePath As String 
    fileSavePath = Environ("USERPROFILE") & "\" & Environ("USERNAME") & "-123-" & fileID & ".xlsx" 

    ' Use Microsoft.XMLHTTP in order to setup a connection. 
    ' https://msdn.microsoft.com/en-us/library/ms535874(v=vs.85).aspx#methods 
    Dim WinHttpReq As Object 
    Set WinHttpReq = CreateObject("MSXML2.XMLHTTP") 
    ' Pass GET to the Open method in order to start the download of the file. 
    WinHttpReq.Open "GET", url, False ' method, http verb, async = false 

    Dim i As Integer 
    i = 0 

    Do While i < 10 

     If DownloadFile(url, fileID, fileSavePath, WinHttpReq) = 1 Then 
      Debug.Print "here" 
      Exit Do 
     Else 
      Debug.Print fileID & " not found! Try number: " & i 
      i = i + 1 
      ' We didnt get the response we wanted, so we will wait one second and try again. 
      Application.Wait (Now + TimeValue("0:00:01")) 
     End If 

    Loop 

End Sub 

Function DownloadFile(url As String, fileID As String, fileSavePath As String, WinHttpReq As Object) 
    ' Send our request: https://msdn.microsoft.com/en-us/library/ms536736(v=vs.85).aspx 
    WinHttpReq.send 

    ' Reset the url parameter to be the body of the response. 
    url = WinHttpReq.responseBody 

    ' WinHttpReq.Status holds the HTTP response code. 
    If WinHttpReq.Status = 200 Then 
     ' Setup an object to hold the binary stream of data (the file). 
     Dim oStream 
     Set oStream = CreateObject("ADODB.Stream") 
     oStream.Open 
     ' Set type read only or not: https://msdn.microsoft.com/en-us/library/ms681553(v=vs.85).aspx 
     oStream.Type = 1 
     ' Write the binary data to WinHttpReq.responseBody 
     ' We can do this because we have confirmed a download via the response code (200). 
     oStream.Write WinHttpReq.responseBody 
     oStream.SaveToFile fileSavePath, 2 ' 2 = overwrites the existing file, 1 = will not. 
     ' We are done we the stream, close it. 
     oStream.Close 
     Debug.Print "File downloaded! File path: " & fileSavePath 
     DownloadFile = 1 
    End If 

    ' Handle if the file doesn't exist. 
    If WinHttpReq.Status = 404 Then 
     DownloadFile = 0 
    End If 

End Function