How to download a file from web URL using VBA

[Sam1085]

Hi All,

I tried to download a file from web address.

Example:

Code: Select all

Private Sub Test()
Dim chromePath As String
On Error GoTo Error
chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Shell (chromePath & " -url https://www.google.com/images/branding/googlelogo/2x/googlelogo_color_120x44dp.png")
Me.Hide
Exit Sub

Error:
chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
Shell (chromePath & " -url https://www.google.com/images/branding/googlelogo/2x/googlelogo_color_120x44dp.png")
Me.Hide
Exit Sub
End Sub

The above code will redirect me to this URL using default web browser in my machine. But I need to download a file (Using Google Chrome) into 'Specific Folder'.
Ex: C:\Users\<UserName>\Downloads\Test

Not sure is it possible. Please let me know if anyone have idea regarding on this.

Thank you!

[HansV]

Like this:

Copy the following code to the top of the module, above all subs and functions:

Code: Select all

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

And this is the code to download the file:

Code: Select all

Private Sub Test()
    Dim strFile As String
    Dim strURL As String
    Dim strPath As String
    Dim ret As Long
    strFile = "googlelogo_color_120x44dp.png"
    strURL = "https://www.google.com/images/branding/googlelogo/2x/" & strFile
    strPath = Environ("UserProfile") & "\Downloads\Test\" & strFile
    ret = URLDownloadToFile(0, strURL, strPath, 0, 0)
    If ret <> 0 Then MsgBox "Something went wrong!", vbInformation
End Sub

[Sam1085]

Thank you Hans,

This is work as I needed.

[Sam1085]

Hi Hans,

I just tried to download excel template (.xltm) using this macro. It works and downloaded but I think it's corrupted. I can't open that file. Do you have any idea about that.

Additional info: Original file size 34kb. Downloaded file size 29kb.

Thank You!

[HansV]

Could you post the URL?

[Sam1085]

I tried to download the excel file from Google Drive.

Direct Download URL: https://drive.google.com/uc?export=down ... WMzeG5lclU" onclick="window.open(this.href);return false;

[HansV]

It worked OK when I tried it with the following code:

Code: Select all

Private Sub Test()
    Dim strURL As String
    Dim strPath As String
    Dim ret As Long
    strURL = "https://drive.google.com/uc?export=download&id=0B1yWnlyZ8msETUEwRWMzeG5lclU"
    strPath = Environ("UserProfile") & "\Documents\Excel\Test.xltm"
    ret = URLDownloadToFile(0, strURL, strPath, 0, 0)
    If ret <> 0 Then MsgBox "Something went wrong!", vbInformation
End Sub

(I used an existing subfolder in my Documents folder)

[Sam1085]

Hi Hans,

Yesterday I tried as the same. But still I got 'Something went wrong!' massage box.

Also I tried added to direct file URL.

Code: Select all

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 Sub Test()
    Dim strFile    As String
    Dim strURL     As String
    Dim strPath    As String
    Dim ret        As Long
    
    strFile = "Style Checklist.xlsx"
    strURL = "https://sites.google.com/a/okwebs.net/test/home/Style%20Checklist.xltm" & strFile
    strPath = Environ("UserProfile") & "\Documents\Excel\Style Checklist.xltm" & strFile
    ret = URLDownloadToFile(0, strURL, strPath, 0, 0)
    If ret <> 0 Then MsgBox "Something went wrong!", vbExclamation
End Sub

Sample File Located on this Test site: https://goo.gl/H27kE5" onclick="window.open(this.href);return false;

Can you download this file and open without corruptions?

Thank you for help!

[HansV]

The lines

Code: Select all

    strFile = "Style Checklist.xlsx"
    strURL = "https://sites.google.com/a/okwebs.net/test/home/Style%20Checklist.xltm" & strFile
    strPath = Environ("UserProfile") & "\Documents\Excel\Style Checklist.xltm" & strFile

make no sense: you have Style Checklist.xltm followed by Style Checklist.xlsx. You should NOT have the ... & strFile here since the file name is already included in the part before it.

[Sam1085]

Hi Hans,

Sorry, I mistakenly added xlsx extension as strFile.

I have fixed it and retry again. I have tested the same code in two different systems. But the result is weird. One machine got downloaded and one machine not... I think it's system configuration problem.

Thank You for the support!

[HansV]

Try this version. It should download to the user's Documents folder:

Code: Select all

Private Sub Test()
    Dim strFile    As String
    Dim strURL     As String
    Dim strPath    As String
    Dim ret        As Long
    
    strURL = "https://sites.google.com/a/okwebs.net/test/home/Style%20Checklist.xltm"
    strPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Style Checklist.xltm"
    ret = URLDownloadToFile(0, strURL, strPath, 0, 0)
    If ret <> 0 Then MsgBox "Something went wrong!", vbExclamation
End Sub

You can use SpecialFolders("Desktop") if you want to download to the user's desktop, or specify a fixed path instead of CreateObject("WScript.Shell").SpecialFolders("MyDocuments").

[Sam1085]

Hi Hans,

Thank you very much.

I tried the above version of code now. But still I got an error. I have recorded my screen. I think it would be helpful you to understand what went wrong.
https://drive.google.com/file/d/0B1yWnl ... sp=sharing" onclick="window.open(this.href);return false;

I think this is my system related configuration or something like that. So, please ignore this if it's too hard to fix by this way :)

Now I just tried to download a file using this method. This will work with Google Chrome browser. So, the file will be download to Chrome download location. (Default is 'Downloads' folder).

Code: Select all

Sub DownloadTest()
Dim chromePath As String
On Error GoTo Error
chromePath = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Shell (chromePath & " -url https://drive.google.com/uc?export=download&id=0B1yWnlyZ8msETUEwRWMzeG5lclU")
Exit Sub

Error:
chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
Shell (chromePath & " -url https://drive.google.com/uc?export=download&id=0B1yWnlyZ8msETUEwRWMzeG5lclU")
Exit Sub
End Sub

Then I have to move the downloaded file into My Documents folder. But I have no idea about how to wait this macro until complete the file download process.

Code: Select all

Private Sub Move_File()
    Name ("C:\Users\" & Environ("UserName") & "\Downloads") & "\Style Checklist.xltm" As CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Style Checklist.xltm"
End Sub

Let me know if you have any better option to do that process via VBA. Thank you!

*Edited