a guest Feb 4th, 2016 109 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
- Sub SaveFileFromURL()
- Const Option_SSLErrorIgnoreFlags = 4
- Const SslErrorFlag_Ignore_All = 13056 ' Ignore all of the above
- Dim FileNum As Long
- Dim FileData() As Byte
- Dim WHTTP As Object
- mainUrl = "https://webservices.youknowtheURL.com"
- fileUrl = "https://webservices.youknowtheURL.com/mobile/rest/reportservice/exportReport?name=shared%2FCharlie+Book%27s2.ppr"
- filePath = "C:\myfile.csv"
- myuser = "loginname"
- mypass = "password"
- '@David Zemens, I got this by examining webpage code using Chrome, thanks!
- strAuthenticate = "start-url=%2F&user=" & myuser & "&password=" & mypass & "&switch=Log+In"
- Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
- 'I figured out that you have to POST authentication string to the main website address not to the direct file address
- WHTTP.Open "POST", mainUrl, False 'WHTTP.Open "POST", fileUrl, False
- WHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- WHTTP.Option(Option_SSLErrorIgnoreFlags) = SslErrorFlag_Ignore_All
- On Error Resume Next
- WHTTP.Send strAuthenticate
- If Err.Number <> 0 Then
- MsgBox Err.Number & ": " & Err.Description
- Exit Sub
- End If
- 'Then you have to GET direct file url
- WHTTP.Open "GET", fileUrl, False
- FileData = WHTTP.ResponseBody
- Set WHTTP = Nothing
- 'Save the file
- FileNum = FreeFile
- Open filePath For Binary Access Write As #FileNum
- Put #FileNum, 1, FileData
- Close #FileNum
- MsgBox "File has been saved!", vbInformation, "Success"
- End Sub
RAW Paste Data