Public Sub DownloadFile()
'
' Need to add references to
' the following object models
' via Tools => References:
'
' 1) Microsoft XML v6.0
' 2) Microsoft ActiveX Data Objects
Const lngOK = 200&
Dim objXmlHttp As New MSXML2.XMLHTTP60
Dim objStream As New ADODB.Stream
Dim strTargetPath As String
Dim strSourceUrl As String
On Error GoTo ErrorHandler
' URL of the file to download (change this!):
strSourceUrl = "http://s2.q4cdn.com/235752014/files/doc_downloads/test.pdf"
' Path to download the file to (change this!)
strTargetPath = "C:\Users\MyUserName\Desktop\test.pdf"
objXmlHttp.Open "GET", strSourceUrl, False
objXmlHttp.send
If objXmlHttp.Status = lngOK Then
objStream.Open
objStream.Type = adTypeBinary
objStream.Write objXmlHttp.responseBody
objStream.SaveToFile strTargetPath, adSaveCreateOverWrite
objStream.Close
MsgBox "File download successful." & vbCrLf & strTargetPath, vbInformation
Else
Err.Raise vbObjectError + 513, "DownloadFile", "HTTP error."
End If
ExitHandler:
On Error Resume Next
objStream.Close
Set objXmlHttp = Nothing
Set objStream = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub