Hi there,
The file was removed some time ago, after various forum upgrades. While the original file is long gone, and also specific to the OP, I've made a sample file and uploaded to my website. The code, at its base, is fairly straight forward - a one line Windows API call. The result will tell you if it was a success or not, a zero being success.
Sample file link.
The sample file doesn't contain a userform like the OP had, but I do use a Range accessor, which is basically a locally named range with a VBA property so I can access it from intellisense anywhere in the workbook.
Worksheet accessor code (requires sheet/local named ranges to match):
VBA Code:
Public Property Get Range_FilePath() As Range
Set Range_FilePath = Me.Range("FilePath")
End Property
Public Property Get Range_FileURL() As Range
Set Range_FileURL = Me.Range("FileURL")
End Property
The code to download the file (all of this is in the sample file) consists of:
- Windows API (both 32- and 64-bit versions)
- Test routine
- Download function
- Supporting functions
Here is the code:
VBA Code:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As LongPtr) As LongPtr
#Else
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
Public Sub Test_DownloadInternetFile()
Debug.Print DownloadInternetFile( _
FileURL:=wTest.Range_FileURL.Value, _
FilePath:=wTest.Range_FilePath.Value, _
NotifyUser:=True)
End Sub
Public Function DownloadInternetFile( _
ByVal FileURL As String, _
ByVal FilePath As String, _
Optional ByVal NotifyUser As Boolean = False _
) As Boolean
Dim DownloadFile As Boolean
Dim FileReplaced As Boolean
If ExistingFile(FilePath) Then
FileReplaced = DeleteFile(FilePath)
If Not FileReplaced Then
MsgBox "File already exists. Could not delete it.", vbExclamation + vbOKOnly
Exit Function
End If
End If
DownloadFile = URLDownloadToFile(0, FileURL, FilePath, 0, 0) = 0
If NotifyUser Then
If DownloadFile Then
If FileReplaced Then
MsgBox "File successfully downloaded and replaced to '" & FilePath & "'.", vbInformation + vbOKOnly
Else
MsgBox "File successfully downloaded to '" & FilePath & "'.", vbInformation + vbOKOnly
End If
Else
MsgBox "Unable to download file. Check your URL and file save name.", vbCritical + vbOKOnly
End If
End If
End Function
Public Function DeleteFile( _
ByVal FilePath As String _
) As Boolean
On Error Resume Next
If ExistingFile(FilePath) Then Kill FilePath
If Err.Number = 0 Then DeleteFile = True
Err.Clear
End Function
Public Function ExistingFile( _
ByVal FilePath As String _
) As Boolean
Dim Attributes As Integer
On Error Resume Next
Attributes = GetAttr(FilePath)
ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
Err.Clear
End Function
Change the cell values to whatever you want, then run
Test_DownloadInternetFile.
HTH
