vba - 如何在 VBA 中更改 HttpRequest 的超时？

Question

我采用了How do I download a file using VBA (without Internet Explorer)中的代码。除非设备没有应答，否则它工作正常。大约 18 秒后，我将收到错误消息（“-2146697211，系统无法找到指定的资源。”），但在此期间 PC 几乎死机。

由于设备是本地的，我认为 300..500 毫秒的超时就可以了。

Function netDownloadFile(ByVal sURL As String, _
                        ByVal sLocalFile As String, _
                        ByRef pCallbackFunc As Long, _
                        ByRef uTimeoutMillis As Long) As Long
' https://stackoverflow.com/questions/17877389/how-do-i-download-a-file-using-vba-without-internet-explorer
  On Error GoTo Err_netDownloadFile
Dim oStream As Object
Dim WinHttpReq As Object
  netDownloadFile = 0
  Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
  WinHttpReq.SetTimeouts uTimeoutMillis, uTimeoutMillis, uTimeoutMillis, uTimeoutMillis
  WinHttpReq.Open "GET", sURL, False
  'WinHttpReq.Open "GET", sURL, False, "username", "password"
  WinHttpReq.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"     'disallow caching to get realtime results
  WinHttpReq.send
  
  netDownloadFile = WinHttpReq.status
  Debug.Print WinHttpReq.getAllResponseHeaders
  If WinHttpReq.status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile sLocalFile, 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
    GoTo Exit_netDownloadFile
  Else
    gErrDescription = WinHttpReq.getAllResponseHeaders
  End If

Exit_netDownloadFile:
  Exit Function
  
Err_netDownloadFile:
  netDownloadFile = Err.Number
  gErrDescription = Err.Description
  Resume Exit_netDownloadFile
End Function

对此的调用将是：

lngDownloadResult = netDownloadFile("http://192.168.56.42/status/meters", "C:\Temp\Jacuzzi.txt", 0, 300)

我将收到 WinHttpReq.SetTimeouts 的运行时错误：“438 - 对象不支持此属性或方法”。所以这似乎不受 Microsoft.XMLHTTP 支持

我如何需要重新编码（或使用哪个库），以使用短超时？

标签： vbams-accessms-access-2010serverxmlhttp