Accion solo si existe archivo en la web

Option Compare Database
Option Explicit


' Codigo original de Glen Kruger

#If Win64 Then
    Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
    Private Declare PtrSafe Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
    Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
    Private Declare PtrSafe Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
    Private Declare PtrSafe 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
#Else
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
    Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
    Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
    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
#End If

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Dim x       As Boolean
Dim hInet   As Long
Dim hUrl    As Long
Dim Flags   As Long
Dim URL     As Variant

Public Function CheckConnection() As Boolean
    hInet = InternetOpen(" ", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
    If hInet Then
        Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
        hUrl = InternetOpenUrl(hInet, "http://www.google.com", vbNullString, 0, Flags, 0)
        If hUrl Then
            CheckConnection = True
            Call InternetCloseHandle(hUrl)
        Else
            CheckConnection = False
            x = False
        End If
    End If
    Call InternetCloseHandle(hInet)

End Function

Function ReadUrlText(StrUrl As String) As String

    ' lee un fichero de texto situado en un url determinada
    Dim hOpen   As Long
    Dim hFile   As Long
    Dim sBuffer As String
    Dim ret     As Long
    
    sBuffer = Space(100000)
    hOpen = InternetOpen("", 1, vbNullString, vbNullString, 0)
    hFile = InternetOpenUrl(hOpen, StrUrl, vbNullString, ByVal 0&, &H80000000, ByVal 0&)
    InternetReadFile hFile, sBuffer, 100000, ret
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    ReadUrlText = sBuffer
End Function

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean

    ' descarga el fichero de URL en la ruta especificada
    Dim lngRetVal As Long
    
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then
        DownloadFile = True
    End If

End Function