Открытие объекта «IXMLHTTPRequest» не выполняется внутри цикла

Question

Я хотел бы проверить мой сервер на наличие файла каждую секунду в течение примерно десяти секунд. Если файл есть, загрузите его. Там его нет (404), попробуйте еще раз, до десяти раз разбросанных за десять секунд. Я обычно не код в 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 

И у меня есть Sub, который вызывает эту функцию до десяти раз:

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

Извините, но этот вопрос и ответы вводят в заблуждение. Код содержит ошибку в строке

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

где url наполняется с двоичными данными. Зачем ты это делаешь? Уверенный в использовании ByVal означает, что каждый раз, когда вы получаете новую копию url, но зачем вы это делаете? Я прокомментировал эту строку, и проблема исчезла.

Итак, ИМХО, это не имеет ничего общего с созданием MSXML2.XMLHTTP и сборкой мусора, который прошел только url, был недействителен.

Answer 2

Не могли бы вы попытаться создать WinHttpReq в методе Callee и просто использовать этот объект для отправки запроса? Пример:

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