How can I change the Timeout of a HttpRequest in VBA?

498 Views Asked by At

I adopted code from How do I download a file using VBA (without Internet Explorer). It works fine unless when there is no answer from the device. I will get an error ("-2146697211, The system cannot locate the resource specified.") after approx 18 seconds, but during that time the PC is almost dead.

As the device is local I think a timeout of 300..500 ms will do.

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

The call to this will be:

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

I'll get a runtime-error for WinHttpReq.SetTimeouts: "438 - Object doesn't support this property or method". So this seems not supported by Microsoft.XMLHTTP

How do I need to recode (or to use which library), to use a short timeout?

0

There are 0 best solutions below