Mass Hypelink Download

Minititan

New Member
Joined
Jun 13, 2008
Messages
6
I have a list of 2000 hyperlinks (http) that I need to download, I'm working on a corporate network so I can't just use a mass download client. Cany anyone give me some guidance creating a macro to save the target of the hyperlink as a file then move on to the next hyperlink until the list is exhausted.

Is this possible?
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
L

Legacy 98055

Guest
This example will download three small text files to your C drive's root. Make sure you have permission for your local filename path...

<a href="http://home.fuse.net/tstom/324697.0613081406.zip"><img src="http://home.fuse.net/tstom/zip.gif"width="16"height="16"border="0"></a> <a href="http://home.fuse.net/tstom/324697.0613081406.zip">324697.0613081406.zip</a>

Code:
Option Explicit

'code goes in the same worksheet containing your lists
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


Function DownloadFile(URL As String, LocalFileName As String) As Boolean
    If URLDownloadToFile(0, URL, LocalFileName, 0, 0) = 0 Then
        DownloadFile = True
    End If
End Function

'assumes that your URLs are in column a of this worksheet
'and the local filenames to be saved to are in column b
'leave column c blank.  will write status of download there
Sub Example()
    Dim r As Range
    
    Set r = [a1]
    
    Do Until r = ""
        r.Offset(, 2) = DownloadFile(CStr(r.Value), CStr(r.Offset(, 1).Value))
        Set r = r.Offset(1)
    Loop
End Sub
 

Minititan

New Member
Joined
Jun 13, 2008
Messages
6
Thats fantastic, I have one more problem though. The hyperlinks point at different file types such as powerpoint files, word documents, pdf files amongst others. The URL the hyperlink points at does not contain the file type either. I'll PM you an actual URL if that would be of any help, it won't be active as its from our intranet.

Thank you for your help, this is the closest I've come to a solution.
 
L

Legacy 98055

Guest
Paste this code in the worksheet class module that contains you URLs. The URLs should be listed from A1 to A?. If the code fails, remove the comment from this line...
' Debug.Print Request.GetAllResponseHeaders
...and reply with a copy of the text that displays in the immediates window.

Code:
Option Explicit

Private Const Folder As String = "C:\Users\Tom\Desktop"

'assumes that your URLs are in A1:A? of this worksheet
Sub Example()
    Dim r As Range
    Dim ResolvedToLocal As String
    
    Set r = [a1]
    
    Do Until r = ""
        r.Offset(, 2) = DownloadFile(CStr(r.Value), ResolvedToLocal)
        r.Offset(, 1) = ResolvedToLocal
        Set r = r.Offset(1)
    Loop
End Sub

Function DownloadFile(ByVal URL As String, Optional ByRef ResolvedToLocal As String) As Boolean
    Dim Request As New WinHttpRequest
    Dim FileNum As Integer
    Dim FileName As String
    Dim b() As Byte

    On Error GoTo Err_DownloadFile
    
    Request.Open "GET", URL, False
    Request.Send
    
'    Debug.Print Request.GetAllResponseHeaders

    FileName = Request.GetResponseHeader("Content-disposition")
    FileName = Mid(FileName, InStrRev(FileName, "=") + 1)
    FileName = Folder & "\" & Replace(FileName, """", "")
    ResolvedToLocal = FileName
    
    FileNum = FreeFile
    Open FileName For Binary As #FileNum
        b() = Request.ResponseBody
        Put #FileNum, 1, b()
    Close FileNum
    
    DownloadFile = (Request.StatusText = "OK")
     
Err_DownloadFile:
End Function
 

Minititan

New Member
Joined
Jun 13, 2008
Messages
6

ADVERTISEMENT

This is what I'm getting. I can only try it with the dead links at the moment as I'm not in work until Monday now.
code.jpg
 
L

Legacy 98055

Guest
Use this version. The attached file has several example download that you can try out.

<a href="http://home.fuse.net/tstom/0613082100.1595532.zip"><img src="http://home.fuse.net/tstom/zip.gif"width="16"height="16"border="0"></a> <a href="http://home.fuse.net/tstom/0613082100.1595532.zip">0613082100.1595532.zip</a>

Code:
Option Explicit

Private Const Folder As String = "C:\Users\Tom\Desktop\Temp"

'assumes that your URLs are in A1:A? of this worksheet
Sub Example()
    Dim r As Range
    Dim ResolvedToLocal As String
    Dim Request As Object
    
    On Error Resume Next
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
    If Request Is Nothing Then
        Set Request = CreateObject("WinHttp.WinHttpRequest.5")
    End If
    On Error GoTo 0
    
    If Request Is Nothing Then
        'WinHttp not installed
        Exit Sub
    End If
    
    Set r = [a1]
    
    Do Until r = ""
        r.Offset(, 2) = DownloadFile(Request, CStr(r.Value), ResolvedToLocal)
        r.Offset(, 1) = ResolvedToLocal
        Set r = r.Offset(1)
    Loop
End Sub

Function DownloadFile(Request As Object, ByVal URL As String, Optional ByRef ResolvedToLocal As String) As Boolean
    Dim FileNum As Integer
    Dim FileName As String
    Dim b() As Byte

    On Error GoTo Err_DownloadFile
    
    Request.Open "GET", URL, False
    Request.Send
    
    Debug.Print Request.GetAllResponseHeaders

    FileName = Request.GetResponseHeader("Content-disposition")
    FileName = Mid(FileName, InStrRev(FileName, "=") + 1)
    FileName = Folder & "\" & Replace(FileName, """", "")
    ResolvedToLocal = FileName
    
    FileNum = FreeFile
    Open FileName For Binary As #FileNum
        b() = Request.ResponseBody
        Put #FileNum, 1, b()
    Close FileNum
    
    DownloadFile = (Request.StatusText = "OK")
     
Err_DownloadFile:
End Function
 

Minititan

New Member
Joined
Jun 13, 2008
Messages
6

ADVERTISEMENT

Sorry for the lateness in giving my feedback to this solution.

Thank you for your help, I'm still having problems due to a new problem. After trying the macro all I was getting was "false" in the status column, after many attempts to work out the problem I have found it. the document management software we use translates the link server side, below is an example of the steps the link goes through.

http://ourdocumentserver/viewdocument.asp?docno=PROQ-0000061

http://ourdocumentserver/document/detail/viewthisdocument.asp?FILE=PROQ%2D0000061%2D%28LIVE%2D295393143%29%2EPPS

http://ourdocumentserver/temp/PROQ-0000061-(LIVE-295393143).PPS

The bits in red are a constant, the text in green is not static, it is generated from the second link (in purple)

Is it possible to have a macro clicking the link, open ie, click save as then move down the list on to the next link? I know this approach is not as streamlined as your first approach, but is there another solution?
 
L

Legacy 98055

Guest
It should still work as ultimately the client will recieve the download as a response. Can you locate similiar serverside behavior on the net? If so I can fiddle with it and see what must be done to resolve the URLs. We likely will need to append a header and setting the content type.

Debug.Print Request.GetAllResponseHeaders
What are you seeing in the immediates window?

Try the POST method instead of GET
Request.Open "GET", URL, False
to
Request.Open "POST", URL, False
 

Minititan

New Member
Joined
Jun 13, 2008
Messages
6
with both GET and POST the immediates window reads

Connection: close
Date: Wed, 02 Jul 2008 10:18:07 GMT
Server: Microsoft-IIS/6.0
X-Powered-By: ASP.NET
Content-Type: text/html
Expires: Tue, 01 Jul 2008 09:18:07 GMT
Cache-control: private
 
L

Legacy 98055

Guest
"Is it possible to have a macro clicking the link, open ie, click save as then move down the list on to the next link? I know this approach is not as streamlined as your first approach, but is there another solution?"

Yes. You could manipulate the SaveAs dialog but it seems to be a hack that should not be neccesary. I have a post that did something similiar by using the SaveAs dialog for the actual webpage <A HREF="http://www.mrexcel.com/forum/showthread.php?t=229435&highlight=saveas+internet+explorer" TARGET="_blank">here.</A> If you search my username, Right_Click, and SendMessage, for instance, or just SendMessage in general, you will find examples of controlling dialogs. Let me know if you get stuck...
 

Watch MrExcel Video

Forum statistics

Threads
1,129,592
Messages
5,637,291
Members
416,963
Latest member
zazama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top