Downloading A File From The Web
This page describes how to use VBA to download a file from the web.
Your application may need to download a file from the web. This is an easy task to complete. The code
on this page uses the URLDownloadToFile Windows API function to perform the
actual download. The code that wraps up this API, a function called DownloadFile, handles
the circumstances when the local destination file already exists. The function prototype of DownloadFile
is as follows:
Public Function DownloadFile(UrlFileName As String, _
DestinationFileName As String, _
Overwrite As DownloadFileDisposition, _
ErrorText As String) As Boolean
The parameter UrlFileName is the full URL of the file to be downloaded, such as
http://www.cpearson.com/Zips/FindAll.zip. The
DestinationFileName parameter is the name of the local file on your machine where the downloaded
file should be stored. This must be a fully qualified file name, not a folder name. The
Overwrite parameter specifies how to handle the case when
DestinationFileName already exists. If Overwrite is
OverwriteKill (= 0), the existing file is deleted with the Kill
function. If Overwrite is OverwriteRecycle (= 1), the local file
is sent to the Windows Recycle Bin. If Overwrite is DoNotOverwrite (= 2)
the local file will not be overwritten and the download operation will not be carried out. If Overwrite
is PromptUser (= 3) ,the user is prompted with a MsgBox asking whether to replace the existing file. If the user
chooses No, the download operation is cancelled. If the user chooses Yes, the existing file is sent to the
Windows Recycle Bin. The ErrorText parameter is a string that will be populated with the reason
the download failed. If the download was successful, ErrorText is set to an empty string.
The function returns True if the download was successful, or False if the download
failed. If the download failed, ErrorText will contain the reason.
The complete code is shown below. The code includes the DownloadFile procedure and the
RecycleFileOrFolder procedure to send the existing file to the Recycle Bin, if necessary.
Option Explicit
Option Compare Text
Public Enum DownloadFileDisposition
OverwriteKill = 0
OverwriteRecycle = 1
DoNotOverwrite = 2
PromptUser = 3
End Enum
Private Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
Alias "PathIsNetworkPathA" ( _
ByVal pszPath As String) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" _
Alias "GetSystemDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Private Declare Function SHEmptyRecycleBin _
Lib "shell32" Alias "SHEmptyRecycleBinA" _
(ByVal hwnd As Long, _
ByVal pszRootPath As String, _
ByVal dwFlags As Long) As Long
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const MAX_PATH As Long = 260
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
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 DeleteUrlCacheEntry Lib "wininet.dll" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Function DownloadFile(UrlFileName As String, _
DestinationFileName As String, _
Overwrite As DownloadFileDisposition, _
ErrorText As String) As Boolean
Dim Disp As DownloadFileDisposition
Dim Res As VbMsgBoxResult
Dim B As Boolean
Dim S As String
Dim L As Long
ErrorText = vbNullString
If Dir(DestinationFileName, vbNormal) <> vbNullString Then
Select Case Overwrite
Case OverwriteKill
On Error Resume Next
Err.Clear
Kill DestinationFileName
If Err.Number <> 0 Then
ErrorText = "Error Kill'ing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
DownloadFile = False
Exit Function
End If
Case OverwriteRecycle
On Error Resume Next
Err.Clear
B = RecycleFileOrFolder(DestinationFileName)
If B = False Then
ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
DownloadFile = False
Exit Function
End If
Case DoNotOverwrite
DownloadFile = False
ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
Exit Function
'Case PromptUser
Case Else
S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
"Do you want to overwrite the existing file?"
Res = MsgBox(S, vbYesNo, "Download File")
If Res = vbNo Then
ErrorText = "User selected not to overwrite existing file."
DownloadFile = False
Exit Function
End If
B = RecycleFileOrFolder(DestinationFileName)
If B = False Then
ErrorText = "Error Recycle'ing file '" & DestinationFileName & "." & vbCrLf & Err.Description
DownloadFile = False
Exit Function
End If
End Select
End If
L = DeleteUrlCacheEntry(UrlFileName)
L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)
If L = 0 Then
DownloadFile = True
Else
ErrorText = "Buffer length invalid or not enough memory."
DownloadFile = False
End If
End Function
Private Function RecycleFileOrFolder(FileSpec As String) As Boolean
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
If (Dir(FileSpec, vbNormal) = vbNullString) And _
(Dir(FileSpec, vbDirectory) = vbNullString) Then
RecycleFileOrFolder = True
Exit Function
End If
With FileOperation
.wFunc = FO_DELETE
.pFrom = FileSpec
.fFlags = FOF_ALLOWUNDO
.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
End With
lReturn = SHFileOperation(FileOperation)
If lReturn = 0 Then
RecycleFileOrFolder = True
Else
RecycleFileOrFolder = False
End If
End Function
 |
This page last updated: 23-April-2009. |