如何在VBA中更改HttpRequest的超时?

问题描述

我采用了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
  WinHttpReq.Open "GET",sURL,False
  'WinHttpReq.Open "GET",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",300)

我将收到WinHttpReq.SetTimeouts的运行时错误:“ 438-对象不支持此属性或方法”。因此,Microsoft.XMLHTTP

似乎不支持此功能。

如何使用短超时重新编码(或使用哪个库)?

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)