How to Download A File From Internet using VBA

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • Rabbit
    Recognized Expert MVP
    • Jan 2007
    • 12517

    How to Download A File From Internet using VBA

    I often use this to download a CSV to update data in a database.
    Code:
    Option Compare Database
    Option Explicit
    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
    Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
    Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
    
    Declare Function SystemParametersInfo Lib "user32" _
          Alias "SystemParametersInfoA" (ByVal iAction As Long, _
          ByVal iParam As Long, pvParam As Any, _
          ByVal fWinIni As Long) As Long
    
    'Purpose     :  Retreview text from a web site
    'Inputs      :  sURLFileName            The URL and file name to download.
    '               sSaveToFile             The filename to save the file to.
    '               [bOverwriteExisting]    If True overwrites the file if it exists
    'Outputs     :  Returns True on success.
    Function InternetGetFile(sURLFileName As String, sSaveToFile As String, Optional bOverwriteExisting As Boolean = False) As Boolean
        Dim lRet As Long
        Const S_OK As Long = 0, E_OUTOFMEMORY = &H8007000E
        Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000
        Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3
        Const INTERNET_FLAG_RELOAD = &H80000000
        
        On Error Resume Next
        DoCmd.Hourglass True
        
        'Create an internet connection
        lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
        
        If bOverwriteExisting Then
            If Len(Dir$(sSaveToFile)) Then
                VBA.Kill sSaveToFile
            End If
        End If
        
        'Check file doesn't already exist
        If Len(Dir$(sSaveToFile)) = 0 Then
            'Download file
            lRet = URLDownloadToFile(0&, sURLFileName, sSaveToFile, 0&, 0)
            If Len(Dir$(sSaveToFile)) Then
                'File successfully downloaded
                InternetGetFile = True
            Else
                'Failed to download file
                If lRet = E_OUTOFMEMORY Then
                    Debug.Print "The buffer length is invalid or there was insufficient memory to complete the operation."
                Else
                    Debug.Assert False
                    Debug.Print "Error occurred " & lRet & " (this is probably a proxy server error)."
                End If
                InternetGetFile = False
            End If
        End If
        
        On Error GoTo 0
        DoCmd.Hourglass False
    End Function
Working...