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

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

2 个答案: