Option Compare Database
Option Explicit
 
'Public Declare Function netDownloadFile Lib "vbarchiv.dll" _
'                       (ByVal sUrl As String, _
'                        ByVal sLocalFile As String, _
'                        ByRef pCallbackFunc As Long, _
'                        ByRef uTimeoutMillis As Long) As Boolean
 
Private Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
 
Function netDownloadFile(ByVal sUrl As String, _
                        ByVal sLocalFile As String, _
                        ByRef pCallbackFunc As Long, _
                        ByRef uTimeoutMillis As Long) As Boolean
Dim lngRetVal As Long
  lngRetVal = URLDownloadToFile(0, sUrl, sLocalFile, 0, 0)
  If lngRetVal = 0 Then
    netDownloadFile = True
  Else
    netDownloadFile = False
  End If
End Function
 
Sub TestHTMLDownload()
Dim bSuccess As Boolean
  'meine Problemseite
  bSuccess = netDownloadFile("http://www.toppreise.ch/", _
    "D:\HtmlDownload\demo.HTM", 0, 5000)
 
'  'funktioniert
'  bSuccess = netDownloadFile("http://www.oelclick.ch/", 
' "D:\HtmlDownload\demo.HTM", 0, 5000)
End Sub