Question

我正在尝试从该网站下载文件，尝试了一些我可以找到的代码，并且文件被下载，但显示了登录页面的html

以下是我尝试的2个版本。我尝试了所有可以在SO上找到的代码段，但到目前为止还没有运气。

我在这里尝试了两个版本，它们都有相同的问题，但是它们的解决方案不适用于我。 Vba download file from internet WinHttpReq with login not working

似乎我没有结束登录过程。我知道下面的代码中的变量（用户名，密码）是错误的，但是我确实尝试了可以在源代码中找到的每个变量（UniqueUser，UniqueLogin，LoginName，他们在其中遇到的每个单词），但还是没有运气。

SET COOKIE行上的某些版本的代码错误，其他版本没有错误，文件已下载，但仍然是文件内登录页面的

 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

您正在将登录详细信息发送到错误的登录地址。您的正确登录地址为https://pnds.health.ny.gov/account/login，页面需要登录名和令牌。令牌是使用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

Answer 2

我会做一点递归功能，检查重定向，直到没有剩余为止。

赞：

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= GetResult(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

注意：此代码未经测试，需要针对您的用例进行修改。

登录时VBA下载文件不起作用

2 个答案: