Excel VBA WinHTTP从受密码保护的https网站下载文件

我正在尝试使用WinHTTP从受https密码保护的站点保存文件。代码如下：

Sub SaveFileFromURL()

Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object

fileUrl = "https://www.website.com/dir1/dir2/file.xls"
filePath = "C:\myfile.xls"

myuser = "username"
mypass = "password"

Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")

WHTTP.Open "GET", fileUrl, False
WHTTP.SetCredentials myuser, mypass, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
WHTTP.Send

FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

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

Sub SaveFileFromURL()

Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object

mainUrl = "https://www.website.com/"
fileUrl = "https://www.website.com/dir1/dir2/file.xls"
filePath = "C:\myfile.xls"

myuser = "username"
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.Send strAuthenticate

'Then you have to GET direct file url
WHTTP.Open "GET", fileUrl, False
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

问题在于身份验证。文件正在保存，但当我在Excel中打开它时，它只是html登录页，而不是实际的文件。如果我复制直接文件url并将其粘贴到浏览器地址栏，而我没有登录到该网页，效果是相同的。我看到了登录页面。然后，如果我输入登录名和密码，下载窗口将显示，允许我保存文件

所以我认为代码的SetCredentials部分工作不正常，因为如果我调试.print WHTTP.responseBy，它是html代码而不是实际文件数据

有没有办法将用户ID和密码传递给WinHTTP，以便我能够正确保存文件

以下是页面地址：

https://sst.msde.state.md.us/

==================================编辑：========================

所以我今天玩了一点，我想我正在前进。这是我得到的。我修改了如下代码：

Sub SaveFileFromURL()

Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object

fileUrl = "https://www.website.com/dir1/dir2/file.xls"
filePath = "C:\myfile.xls"

myuser = "username"
mypass = "password"

strAuthenticate = "start-url=%2F&user=" & myuser & "&password=" & mypass & "&switch=Log+In"

Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")

WHTTP.Open "POST", fileUrl, False
WHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WHTTP.Send strAuthenticate

WHTTP.Open "GET", fileUrl, False
WHTTP.Send

Debug.Print WHTTP.GetAllResponseHeaders()

FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

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

当我调试.Print WHTTP.GetAllResponseHeaders（）时，我得到例如：

Accept-Ranges: bytes
Content-Disposition: attachement; filename="xxx"
Content-Length: xxxxxx
Content-Type: application/octet-stream

因此，我认为身份验证有效，但我仍然无法保存文件。当我继续：

FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

FileNum = FreeFile
Open filePath For Binary Access Write As #FileNum
    Put #FileNum, 1, FileData
Close #FileNum

保存文件的内容是html网页本身，而不是文件

---

我是否严格执行了身份验证，问题在于将文件保存到磁盘，或者身份验证仍然存在问题，这就是我无法保存文件的原因？有什么线索吗？

好的，我找到了。代码如下：

Sub SaveFileFromURL()

Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object

fileUrl = "https://www.website.com/dir1/dir2/file.xls"
filePath = "C:\myfile.xls"

myuser = "username"
mypass = "password"

Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")

WHTTP.Open "GET", fileUrl, False
WHTTP.SetCredentials myuser, mypass, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
WHTTP.Send

FileData = WHTTP.ResponseBody
Set WHTTP = Nothing

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

Sub SaveFileFromURL()

Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object

mainUrl = "https://www.website.com/"
fileUrl = "https://www.website.com/dir1/dir2/file.xls"
filePath = "C:\myfile.xls"

myuser = "username"
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.Send strAuthenticate

'Then you have to GET direct file url
WHTTP.Open "GET", fileUrl, False
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

谢谢你的帮助

顺便说一句，我发现这些帖子非常有用：

---

设置凭据似乎不太可靠。您可以改用POST/GET方法。在何处/如何使用POST/GET方法？在设置凭据之前，我正在代码中使用它，但它不起作用。有什么建议吗？@user2267971这个答案：可能会有帮助。除此之外，您可以通过IE自动登录页面，提交您的用户ID和密码，然后导航到该页面以获取您需要的信息。我已经自动登录以获取直接文件URL。但我想能够下载文件“静默”，没有任何弹出的下载窗口。获取WHTTP.ResponseBody对于其他未受密码保护的站点以及一些受密码保护的http站点非常有用。问题在于这个特定的https站点。顺便说一句，我必须使用IE来完成这一步。编辑：查看我提供的网站的html代码，是否有可能找到传递用户名和密码以及正确下载文件的方法？