对象 'IXMLHTTPRequest' 的打开在循环内失败

Open of object 'IXMLHTTPRequest' fails inside loop

我想在大约十秒钟内每秒检查一次我的服务器是否存在一个文件。如果文件在那里,请下载它。它不存在 (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 以防万一没有处理某种垃圾收集,但是我意识到这个变量的范围是我的函数,所以...

感谢您的帮助。

您能否尝试在 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

抱歉,这个问题和答案具有误导性。该代码在行

中有一个错误
' Reset the url parameter to be the body of the response.
url = WinHttpReq.responseBody

其中 url 被二进制数据填充。你为什么做这个?当然使用 ByVal 意味着你每次都会得到 url 的新副本,但你为什么要这样做?我注释掉了这一行,问题就消失了。

所以,恕我直言,这与 MSXML2.XMLHTTP 的实例化和垃圾收集无关,只是传入的 url 无效。