Macro: Download ALL Files Linked to by current Sheet

jeffcoleky · Apr 17, 2012

I need a macro that will download all the linked files in the current sheet.

Columns "K" and "L" are ALL URL references or empty cells. Example: http://www.google.com/test.pdf, http://www.google.com/test2.doc, etc.

I'd like to push a button and have all the files that are linked in the spreadsheet to download to a folder I specify in the macro. Is this simple enough to do?

PS. The URL's listed may or may not be actual hyperlinks, but in every situation there is no other data in the cell.

jeffcoleky · Apr 18, 2012

Is there something I need to do differently in my posts to get my questions answered?

I'd really appreciate someone taking the time to help this newbie out. I'll change my post however I can to get an answer, but this question is over my head.

jeffcoleky · May 1, 2012

Bump. Anyone?

I found this on the web but it doesn't work:

Code:

Const TargetFolder = "C:\temp\"

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


For Each Hyperlink In ActiveSheet.Hyperlinks
    For N = Len(Hyperlink.Address) To 1 Step -1
        If Mid(Hyperlink.Address, N, 1) <> "/" Then
            LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
        Else
            Exit For
        End If
    Next N
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
    LocalFileName = “”
End Sub

Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub

Norie · May 1, 2012

How does that code not work?

It uses the DownloadFileURL API which is what I would have suggested.

jeffcoleky · May 1, 2012

Norie said:
How does that code not work?

It uses the DownloadFileURL API which is what I would have suggested.

I put the "Sub Downloadhyperlinks()" at the beginning...

I get a "compile error: Only comments may appear after end sub, end function, or end property"

However, i don't know how to run the macro without putting in the "Sub"

circledchicken · May 1, 2012

Hi,

Have you read this from Chip Pearson - he explains it really well:
http://www.cpearson.com/excel/DownloadFile.aspx

The steps to get this working for your situation are:

Paste all of the following code to into a module:

Code:

Option Explicit
Option Compare Text

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modDownloadFile
' By Chip Pearson, chip@cpearson.com, www.cpearson.com/Excel/DownloadFile.aspx
' Date: 23-April-2003
' This module contains the DownloadFile function and supporting players to
' download a file from a URL to a local file name.
'
' Example Usage:
'
'        Dim URL As String
'        Dim LocalFileName As String
'        Dim B As Boolean
'        Dim ErrorText As String
'
'        URL = "http://www.cpearson.com/Zips/FindAll.zip"
'        LocalFileName = "C:\Test\FindAll.zip"
'        B = DownloadFile(UrlFileName:=URL, _
'                        DestinationFileName:=LocalFileName, _
'                        Overwrite:=OverwriteRecycle, _
'                        ErrorText:=ErrorText)
'        If B = True Then
'            Debug.Print "Download successful"
'        Else
'            Debug.Print "Download unsuccessful: " & ErrorText
'        End If
'
' The Overwrite parameter of DownloadFile indicates how to handle the
' case when LocalFileName already exists. It is one of the following
' values:
'        OverwriteKill      use Kill to delete the existing file.
'        OverwriteRecycle   send the existing file to the Recycle Bin.
'        DoNotOverwrite     do not overwrite and terminate the procedure.
'        PromptUser         prompt the user asking whether to overwrite file.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Enum DownloadFileDisposition
    OverwriteKill = 0
    OverwriteRecycle = 1
    DoNotOverwrite = 2
    PromptUser = 3
End Enum

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API functions, constants,and types.
' Used for RecycleFile.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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

'''''''''''''''''''''''''''
' Download API function.
''''''''''''''''''''''''''''''''''''''
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



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFile
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 = 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
        ' Or
        .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
    End With

    lReturn = SHFileOperation(FileOperation)
    If lReturn = 0 Then
        RecycleFileOrFolder = True
    Else
        RecycleFileOrFolder = False
    End If
End Function

Sub example()

Dim URL As String
Dim LocalFileName As String
Dim B As Boolean
Dim ErrorText As String
Dim c As Range

For Each c In Columns("K:L").SpecialCells(xlCellTypeConstants, 23)
    URL = c
    LocalFileName = "[B][COLOR="Red"]C:\temp\[/COLOR][/B]" & Evaluate("TRIM(RIGHT(SUBSTITUTE(""" & c & """,""/"",REPT("" "",1000)),1000))")
    B = DownloadFile(UrlFileName:=URL, _
                    DestinationFileName:=LocalFileName, _
                    Overwrite:=PromptUser, _
                    ErrorText:=ErrorText)
    If B = True Then
        Debug.Print "Download successful"
    Else
        Debug.Print "Download unsuccessful: " & ErrorText
    End If
Next c

End Sub

Run the macro at the end named 'example', changing the part in Red to the folder you want.

Note, I have assumed all the file name links are in column K and L and are in the following format - it is important that the last thing before the filename is a forward slash in each case like below:
http://www.cpearson.com/Zips/FindAll.zip

jeffcoleky · May 2, 2012

Great! I love the script and the modification. I'm no expert but it looks as though it should work.

However, WhenI run it, absolutely nothing happens except for the computer thinks for 1 second. No prompts & no files in the directory.

Is there an easy way for me to figure out why it's not working?

PS. THANK YOU SO MUCH for taking the time to help me.

Norie · May 2, 2012

Jeff

Did you adapt the code for your circumstances or vice versa?

Also, in your original code were you getting valid URLS from the hyperlinks?

jeffcoleky · May 2, 2012

Norie said:
Jeff

Did you adapt the code for your circumstances or vice versa?

As far as I could tell it was already fine the way it was since you had already modified the script at the end. All the other parameters were fine.

So no, it was already done. What you see is what i put in. Nothing happens when i run it though--no prompts good or bad.

Norie said:
Also, in your original code were you getting valid URLS from the hyperlinks?

do you mean this?

Code:

Const TargetFolder = "C:\temp\"

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


For Each Hyperlink In ActiveSheet.Hyperlinks
    For N = Len(Hyperlink.Address) To 1 Step -1
        If Mid(Hyperlink.Address, N, 1) <> "/" Then
            LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
        Else
            Exit For
        End If
    Next N
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
    LocalFileName = “”
End Sub

Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub

When I ran that one, excel highlights this code:

Code:

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

then gives me: "compile error: Only comments may appear after end sub, end function, or end property"

Norie · May 2, 2012

Jeff

I didn't post any code.

Is the only problem with the original code that compile error?

The reason for that error is because this code isn't in a sub.

Code:

For Each Hyperlink In ActiveSheet.Hyperlinks
    For N = Len(Hyperlink.Address) To 1 Step -1
        If Mid(Hyperlink.Address, N, 1) <> "/" Then
            LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
        Else
            Exit For
        End If
    Next N
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
    LocalFileName = “”
End Sub

You could simply add something like Sub MyFileDownload() at the top and the code should run, you do need to add another Next as well.

Code:

 Sub MyFileDownload()

 For Each Hyperlink In ActiveSheet.Hyperlinks
    For N = Len(Hyperlink.Address) To 1 Step -1
        If Mid(Hyperlink.Address, N, 1) <> "/" Then
            LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
        Else
            Exit For
        End If
    Next N
    Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
    LocalFileName = “”
Next Hyperlink
 
End Sub

Macro: Download ALL Files Linked to by current Sheet

jeffcoleky

Active Member

Excel Facts

jeffcoleky

Active Member

jeffcoleky

Active Member

Norie

Well-known Member

jeffcoleky

Active Member

circledchicken

Well-known Member

jeffcoleky

Active Member

Norie

Well-known Member

jeffcoleky

Active Member

Norie

Well-known Member

Similar threads

Forum statistics

Share this page

Macro: Download ALL Files Linked to by current Sheet

Active Member

Excel Facts

Active Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock