3

Possible Duplicate:
GET pictures from a url and then rename the picture

I have over 30+ files links I need to download. Is there a way to do this excel?

I want to do in excel because to get those 30+ links I have to do some clean ups which I do in excel.

I need to do this every day. if there is way to do in excel would be awesome.

For example, if A2 is image then download this image into folder

https://www.google.com/images/srpr/logo3w.png

if there is way to rename logo3w.png to whatever is in B2 that would be even more awesome so I won't have to rename file.

Script below, I found online, It works but I need help with rename it.
In column A2:down I have all links
In column B2:down I have filename with extension

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


Sub Test()
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)
Next Hyperlink
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
Community
  • 1
  • 1
Mowgli
  • 3,422
  • 21
  • 64
  • 88
  • At People who marking duplicate, that other post is alternate solution not solution to code I posted. – Mowgli Feb 04 '13 at 13:26

2 Answers2

1

I'm pretty sure you'll be able to slightly modify the following code to satisfy your needs:

Sub DownloadCSV()

Dim myURL As String
myURL = "http://pic.dhe.ibm.com/infocenter/tivihelp/v41r1/topic/com.ibm.ismsaas.doc/reference/LicenseImportSample.csv"

Dim WinHTTPReq As Object
Set WinHTTPReq = CreateObject("Microsoft.XMLHTTP")
Call WinHTTPReq.Open("GET", myURL, False)
WinHTTPReq.send

If WinHTTPReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHTTPReq.responseBody
    oStream.SaveToFile ("D:\DOCUMENTS\timelog.csv")
    oStream.Close
End If

End Sub

Good luck!

Peter L.
  • 7,276
  • 5
  • 34
  • 53
  • Hi Peter, :) this one is for my personal stuff. so where you have myurl can I have put txt file with links in it? – Mowgli Feb 03 '13 at 19:14
  • @Mowgli Sure! Try any valid URL, e.g. SO logo: http://cdn.sstatic.net/stackoverflow/img/apple-touch-icon.png `.SaveToFile` - here specify the local filename. – Peter L. Feb 03 '13 at 19:17
  • Thanks a lot. I am gonna have to edit script bit :) – Mowgli Feb 03 '13 at 19:28
  • @Mowgli my pleasure) all you need is to add loop by any method you like. Get back with more nice questions)) – Peter L. Feb 03 '13 at 19:28
  • Hey Peter, I found this script online is there a way you can help renaming file, I have links from A2 down and file name in B2 (with extension) and down. – Mowgli Feb 03 '13 at 19:54
  • @Mowgli use the same loop code as in https://www.dropbox.com/s/296e200496gd7gb/ListPrinting.xlsm, reading cells from A as URLs, from B as names and add to names your output folder path. Try to do it on your own for practice! – Peter L. Feb 03 '13 at 20:09
0

This should work for you. It will download and rename with the filename that is in column B. I just replaced the 2nd for loop with a line. Hyperlink.range.row gives the row number in which the hyperlink is present. So cells(hyperlink.range.row,2) evaluates to cells(1,2), cells(2,2) and so on (if the data is in A1, A2, A3..). Assuming that you have filename with extension (ex - xyz.png) in column B, this should work.

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


Sub Test()
   For Each Hyperlink In ActiveSheet.Hyperlinks
       LocalFileName=ActiveSheet.cells(hyperlink.Range.Row,2).value
       Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
   Next Hyperlink
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

Let me know if this helps.

Bharath Raja
  • 181
  • 5