VBA macro download source from hyperlink

[roystrobel]

Hi!

My task is:

I have an Excel sheet with a hundred hyperlinks pointing to files on a webserver that need to be retrieved with parameters (e.g. http://mytestserver:8080/Pictures/Image.aspx?id=f924d786-c9ec-4fc5-af53-dd3964f826ca&format=jpg)

Running the above mentioned link opens the file in IE and displays the image with its unique filename stored in a SQL database, but I want to bulk-save the images to a network share.

Whoever runs the macro shall be asked to pick the destination of the files or abort.

Any ideas how to solve this?

 

[roystrobel]

Okay, a friend of mine solved it for me:

Sub DownloadFile()
Dim myURL As String
Dim saveURL As String
Dim WinHttpReq As Object

' this here creates a window to select the folder to which the files will be saved to:
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Pfad As String
saveURL = "H:" 'my standard drive
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Select Folder", &H1000, 17)
On Error Resume Next
Pfad = BrowseDir.items().Item().Path
If Pfad = "" Then Exit Sub
On Error GoTo 0

For Counter = 2 To 10000 ' amount of rows to look for hyperlinks
If Worksheets("Items").Cells(Counter, 6) <> "" Then ' ignore empty cells
saveURL = Path & "" & Worksheets("Items").Cells(Counter, 1) ' 1 = Column with designated names
myURL = Worksheets("Items").Cells(Counter, 6) ' 6 = Column with URLs
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody

oStream.SaveToFile saveURL, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End If
Next Counter

End Sub