从受密码保护的网站下载 xlsx 文件

Question

我正在尝试从受密码保护的网站下载 xlsx 文件以在 PBI 中使用。

在 PBI 上，我已经尝试使用 Power Query 和 Web Connector。我还尝试使用 Power Automate（带有 HTTP 连接器的在线版本，因为我的桌面版本不在后台运行）。 最后我使用VBA。但它们都返回一个包含网站 HTML 代码的文件，而不是 xlsx 中应包含的数据。

上次尝试使用 VBA 的代码（我发现 此处如下（使用通用网站 URL））：

Sub DownloadFile()

    Dim evalURL As String
    Dim streamObject As Object
    Dim winHttpRequest As Object
    Set winHttpRequest = CreateObject("Microsoft.XMLHTTP")

    evalURL = "https://generic_website.com/Excel_file.xslx" '

    winHttpRequest.Open "GET", evalURL, False, "username", "password"
    winHttpRequest.send

    If winHttpRequest.Status = 200 Then
        Set streamObject = CreateObject("ADODB.Stream")
        streamObject.Open
        streamObject.Type = 1
        streamObject.Write winHttpRequest.responseBody
        streamObject.SaveToFile "C:\Users\MyUser\Downloads\Excel_file.xslx", 2 ' 1 = no overwrite, 2 = overwrite
        streamObject.Close
    End If

End Sub

如果我登录该网站并直接在浏览器中打开该 URL，它将下载 .xlsx 文件。

有什么办法可以做到这一点吗？我不知道发生了什么，因为相同的代码对其他人有效。

---

更新：

我尝试了下面的VBA代码，并得到了您可以在图片此处中看到的结果。

Sub Login()

Dim response As String

With CreateObject("Microsoft.XMLHTTP")
  .Open "GET", "https://generic_website.com/Excel_file.xslx", False, "username", "password"
  .send
  response = .responseText
End With

MsgBox response

End Sub

Answer 1

我不知道这是否有效，因为我无法登录，也不知道该文件。希望它能为您指明正确的方向。

' VBA Editor->Tools->References
' find and select the following
' Microsoft WinHTTP Services,version 5.1
' Microsoft HTML Object Library

Sub GetFile()
Dim URL As String: URL = "your url"
Dim File As String: File = "your url/file.xslx"
Dim Email As String: Email = "[email protected]"
Dim Password As String: Password = "Your Password"

Dim Cookie As String
Dim Token As String
Dim Message As String

Dim HTML As HTMLDocument: Set HTML = New HTMLDocument
Dim HTTP As WinHttpRequest: Set HTTP = New WinHttpRequest

' you potentially need the csrf_token to post the login form.
' so we get the token, and any cookies sent
HTTP.Open "GET", URL, True
HTTP.Send
HTTP.WaitForResponse

HTML.body.innerHTML = HTTP.ResponseText

Cookie = HTTP.GetResponseHeader("Set-Cookie")
Token = HTML.getElementsByName("csrf_token")(0).Value

Message = "csrf_token=" & Token & "&email=" & URLEncode(Email) & "&senha=" & URLEncode(Password)

HTTP.Open "POST", URL, True
HTTP.SetRequestHeader "Content-type", "application/x-www-form-urlencoded"
HTTP.SetRequestHeader "Cookie", Cookie
HTTP.Send Message
HTTP.WaitForResponse
Cookie = HTTP.GetResponseHeader("Set-Cookie")

' i dont have credentials so dont know what happens after this point and cannot test any further

HTTP.Open "GET", File, True
HTTP.SetRequestHeader "Cookie", Cookie
HTTP.Send
HTTP.WaitForResponse

msgbox HTTP.responseText

' if the runtime error still occurs then not sure what to do
' however,
' if the above message box looks like HTML, it didnt work.

' if it doesn't, it MIGHT have worked, you just need to
' figure out how to save the data to a file

'Dim FileNumber As Integer: FileNumber = FreeFile()

'Open "C:\destination.xslx" For Binary Access Write As #FileNumber
'Put #FileNumber, 1, HTTP.ResponseBody
'Close #FileNumber

End Sub

'https://stackoverflow.com/a/218199/212869
Public Function URLEncode(StringVal As String) As String
Dim StringLen As Long: StringLen = Len(StringVal)

If StringLen > 0 Then
  ReDim result(StringLen) As String
  Dim i As Long, CharCode As Integer
  Dim Char As String

  For i = 1 To StringLen
    Char = Mid$(StringVal, i, 1)
    CharCode = Asc(Char)
    Select Case CharCode
      Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
        result(i) = Char
      Case 32
        result(i) = "+"
      Case 0 To 15
        result(i) = "%0" & Hex(CharCode)
      Case Else
        result(i) = "%" & Hex(CharCode)
    End Select
  Next i
  URLEncode = Join(result, "")
End If
End Function