Link to home
Start Free TrialLog in
Avatar of bleested
bleested

asked on

VBA Retrieve file from url

Let's say there's an image file at http://www.mywebsite.com/image.jpg.  Can I write Access VBA code that will download and save file image.jpg?
Avatar of Dave
Dave
Flag of United Kingdom of Great Britain and Northern Ireland image

You can probably script this with IE models, but if its for personal use I would download a copy of WGET from:-

http://gnuwin32.sourceforge.net/packages/wget.htm

and use SHELL calls, but then I always was a but of a hacker...
Avatar of nffvrxqgrcfqvvc
nffvrxqgrcfqvvc

Hi, You can place this into module and call DownloadFile(). Supports both http and ftp protocal urls.
Option Explicit

'egl1044
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_RESYNCHRONIZE = &H800&
Private Const WININET_API_FLAG_SYNC = &H4&
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const CREATE_ALWAYS = &H2&
Private Const GENERIC_WRITE = &H40000000
 
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrlW Lib "wininet" (ByVal hInternet As Long, ByVal lpszUrl As Long, ByVal lpszHeaders As Long, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal dwNumberOfBytesToRead As Long, lpdwNumberOfBytesRead As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long
Private Declare Function InternetQueryDataAvailable Lib "wininet" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
 
Public Sub DownloadFile(ByVal szUrl As String, ByVal szFile As String)
  
  Dim Buffer() As Byte ' raw buffer.
  Dim hOpen As Long
  Dim hConn As Long
  Dim hFile As Long
  Dim dwBytes As Long
  Dim dwWrittenBytes As Long
  Dim dwReadBytes As Long
  
  ' Create and overwrite the file with write access.
  hFile = CreateFileW(StrPtr("\\?\" & szFile), GENERIC_WRITE, 0, 0, CREATE_ALWAYS, 0, 0)
  
  ' If this fails check rights and permissions...etc
  If hFile = INVALID_HANDLE_VALUE Then
    
    Debug.Print Err.LastDllError
    
    Exit Sub ' _leave
    
  End If
  
  ' Open connection force sync download.
  hOpen = InternetOpenW(0, 1, 0, 0, WININET_API_FLAG_SYNC)
 
  ' Establish connection to URL.
  hConn = InternetOpenUrlW(hOpen, StrPtr(szUrl), 0, 0, _
    INTERNET_FLAG_NO_CACHE_WRITE Or _
    INTERNET_FLAG_RELOAD Or _
    INTERNET_FLAG_RESYNCHRONIZE, 0)
 
  Do
  
    If InternetQueryDataAvailable(hConn, dwBytes, 0, 0) Then
    
      ' Allocate the amount that is immediatley available.
      ReDim Buffer(dwBytes) As Byte
 
    Else
    
      ' Allocate 4KB chunk if the amount available fails.
      dwBytes = 4096
      
      ReDim Buffer(dwBytes) As Byte
      
    End If
    
    If InternetReadFile(hConn, VarPtr(Buffer(0)), dwBytes, dwReadBytes) Then
      
      ' At this point we can write the bytes to the file.
      WriteFile hFile, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes, 0
      
    Else
    
      Exit Do ' _leave
    
    End If
    
    ' You can add DoEvents here to have have responsive GUI
    ' at the cost of performance.
    ' DoEvents
  Loop Until dwReadBytes = 0
  
  ' perform cleanup.
  InternetCloseHandle hConn
  InternetCloseHandle hOpen
  CloseHandle hFile
  
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of bleested

ASKER

Cactus...your solution is simple and effective.  If a site is password protected, is it possible to add login credentials?
Do you understand the difference between the two methods shown here?
That would be something like this with username and password prefixed:

http://username:password@domain.com/....

but for pages with a little more advanced login mechanics it will not work.

/gustav