从https URL下载图像

时间:2017-03-20 10:12:56

标签: excel vba image ms-access winhttprequest

我正在尝试使用来自MSExcel或MSAccess的VBA使用用户名和密码从 HTTPS 网站下载图像。

使用Windows Photo Viewer打开图像时显示以下消息:

  

Windows照片查看器无法打开图片,因为该文件似乎已损坏,损坏或太大!

似乎根本没有下载图像。

Option Explicit

Sub SaveFileFromURL()

Dim FileData() As Byte
Dim FileNum As Long
Dim WHTTP As Object
Dim mainUrl As String, fileUrl As String, filePath As String, myuser As String, mypass As String
Dim strAuthenticate As String

mainUrl = "https://secure.brandbank.com/login.aspx?"
fileUrl = "https://productlibrary.brandbank.com/image/gallerylarge/3520198"

' OR fileUrl = "https://productlibrary.brandbank.com/LabelImage/ViewLabel?pvid=3520198"

filePath = "D:\DOWNLOADS\SYS\test.jpg"

' dummy UN, PW    
myuser = "admin"
mypass = "Password"

'strAuthenticate = "start-url=%2F&user=" & myuser & "&password=" & mypass & "&switch=Log+In"
'strAuthenticate = "txtemail=myuser&txtpassword=mypass&cookieCheck=true"

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.Option(6) = False      'WinHttpRequestOption_EnableRedirects
WHTTP.Open "POST", mainUrl, False 'WHTTP.Open "POST", fileUrl, False
'WHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WHTTP.SetRequestHeader "Content-Type", "multipart/form-data"
'WHTTP.Send strAuthenticate

'Then you have to GET direct file url
WHTTP.Open "GET", fileUrl, False, myuser, mypass
WHTTP.Send

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

此代码适用于HTTP访问。如何修改它以从此HTTPS站点下载图像?

0 个答案:

没有答案