VBA 登录后无法下载文件

Question

我正在尝试从此网站下载文件，尝试了一堆我能找到的代码，文件已下载，但显示登录页面的 html

以下是我试过的两个版本。我尝试了我能在 SO 上找到的所有代码片段，但到目前为止运气不佳。

我在这里尝试了两个版本，他们有同样的问题，但他们的解决方案对我不起作用。

我似乎没有通过登录过程。我知道下面代码中的变量（用户名、密码）是错误的，但我确实尝试了我能在源代码中找到的每个变量（UniqueUser、UniqueLogin、LoginName，他们在那里的每个词），但仍然没有成功。

某些版本的代码在 SET COOKIE 行有错误，其他版本没有错误，文件已下载，但它仍然是文件

中登录页面的 html

 Sub DownloadFile2(myURL As String)


Dim CurPath As String

CurPath = CurrentProject.Path & "\"
Dim strCookie As String, strResponse As String, _
  strUrl As String
  Dim xobj As Object
  Dim WinHttpReq As Object
  Set xobj = New WinHttp.WinHttpRequest

UN = "hhhhh"
PW = "gggg"

  strUrl = "https://pnds.health.ny.gov/login"
  xobj.Open "POST", strUrl, False
  xobj.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36"
  xobj.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  xobj.Send "username=" & UN & "&password=" & PW & "&login=login"
  strResponse = xobj.ResponseText

  strUrl = myURL
  xobj.Open "GET", strUrl, False

  xobj.SetRequestHeader "Connection", "keep-alive"
  xobj.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36"
  xobj.Send

  strCookie = xobj.GetResponseHeader("Set-Cookie")
  strResponse = xobj.ResponseBody

 If xobj.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write xobj.ResponseBody
    oStream.SaveToFile CurPath & "ValidationDataHFIS.csv", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If
End Sub


Sub ddd()

DownloadFile2 ("https://pnds.health.ny.gov/xxxx/xxxx/8")
End Sub

Answer 1

我会做一个小的递归函数来检查重定向，直到剩下 none。

像这样：

Option Explicit
Const WinHttpRequestOption_EnableRedirects = 6

Public Function GetRedirect(ByRef oHttp As Object, ByVal strUrl As String) As String
    With oHttp
        .Open "HEAD", strUrl, False
        .Send
    End With

    If oHttp.Status = 301 Or oHttp.Status = 302 Or oHttp.Status = 303 Then
        GetRedirect= GetRedirect(oHttp, oHttp.GetResponseHeader("Location"))
    Else
        GetRedirect= strUrl
    End If
End Function

Sub DownloadFile2(myURL As String)

    Dim CurrentProject
    Dim CurPath As String

    CurPath = CurrentProject.Path & "\"
    Dim strCookie As String, strResponse As String, _
    strUrl As String
    Dim xobj As Object
    Dim WinHttpReq As Object
    Set xobj = CreateObject("WINHTTP.WinHTTPRequest.5.1")
    Dim UN As String
    UN = "hhhhh"
    Dim PW As String
    PW = "gggg"

    strUrl = "https://pnds.health.ny.gov/login"
    With xobj
        .Open "POST", strUrl, False
        .SetRequestHeader "Connection", "keep-alive"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/33.0.1750.154 Safari/537.36"
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send "&username=" & UN & "&password=" & PW & "&login=login"
    End With

    strUrl = GetRedirect(xobj, myURL)

    If xobj.Status = 200 Then
        Dim oStream As Object
        Set oStream = CreateObject("ADODB.Stream")
        With oStream
            .Open
            .Type = 1
            .Write xobj.ResponseBody
            .SaveToFile CurPath & "ValidationDataHFIS.csv", 2 ' 1 = no overwrite, 2 = overwrite
            .Close
        End With
    End If
End Sub

Sub ddd()

    DownloadFile2 ("https://pnds.health.ny.gov/xxxx/xxxx/8")
End Sub

注意：此代码未经测试，需要根据您的用例进行调整。

Answer 2

您正在将登录详细信息发送到错误的登录地址。您正确的登录地址是 https://pnds.health.ny.gov/account/login 该页面需要 LoginName 和 Token。使用 SecurityManager.generate( u, p );

生成令牌

您仍然可以咨询他们的 IT 团队，以确保您没有违反他们的政策。

这是一种使用 IE 浏览器对象的方法。

Private Sub DownloadValidationData()
'Create Internet explorer object
Dim IE As Object
Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")

IE.Visible = True

Dim URL As String: URL = "https://pnds.health.ny.gov/account/login"

IE.Navigate URL
While IE.READYSTATE <> READYSTATE_COMPLETE
    DoEvents
Wend

Dim userName As String: userName = "test"
Dim password As String: password = "test"

'Fill the login form
IE.Document.getElementById("UniqueUser").Value = userName
IE.Document.getElementById("UniquePass").Value = password

'Submit the form
IE.Document.querySelector("button.SignIn").Click

'Wait for login to complete
While IE.READYSTATE <> READYSTATE_COMPLETE
    DoEvents
Wend
'Verify you are logged in: As we don't know what the site looks like after login in. Only you can do this step.

'Navigate to Download Page. This should prompt to save the file.
IE.Navigate theDownloadUrl '"https://pnds.health.ny.gov/xxxx/xxxx/8"

'Once downloaded just close the browser and exit
'IE.Quit
'Set IE = Nothing


'If you are interested in geting/generating the token using their script you can play around with below lines. These lines come before loging in. Please note: execScript is depreciated now

'Dim Token as string
'IE.Document.parentwindow.execScript ("$('#Token').val(SecurityManager.generate(""" & username & """, """ & password & """ ))")
'Token = IE.Document.getElementById("Token").Value
'Use the token to sign in using your code. That'll be xobj.Send "LoginName =" & userName & "&Token=" & Token
'But not sure if it will work.



End Sub

VBA 登录后无法下载文件

VBA downloading file with login isn't working

vba

ms-access

authentication

winhttp