VBA从具有登录名和密码的网站下载csv文件

时间:2014-03-27 00:15:26

标签: vba authentication excel-vba csv winhttprequest

OleHenrikSkogstrøm在帖子中发布了一个回复:“我如何使用VBA下载文件(没有Internet Explorer)”。

使用他的代码,因为我希望从www.ft.com下载csv文件并将其保存到我的c盘上的临时文件中。我不是经常需要这样做,所以我决定使用简单的excel VBA。我在www.FT.com上设置了一个临时测试订阅帐户,以说明我要下载的内容,用户名是“ft.testing.acct@gmail.com”,密码是“fttestpassword”。

登录后,可以在页面的右上角看到“导出数据”链接:

http://portfolio.ft.com/holdings/overview/3415c458-40bf-4e63-903a-37302a88bd83?popout=true&..wsod..=off

点击此链接时传递的网址为:

http://portfolio.ft.com/PortfolioAPI/ExportToCSV?containerID=3415c458-40bf-4e63-903a-37302a88bd83&type=Holdings&customName=suggested__0YourPortfolio&duration=15&startDate=undefined&endDate=undefined

以下代码返回一个文件,但是该文件中只有“{”json“:{”triggerLogin“:true}}”。

Sub downloadingpositions()
Dim myURL As String
myURL = "http://portfolio.ft.com/PortfolioAPI/ExportToCSV?containerID=3415c458-40bf-4e63-903a-37302a88bd83&type=Holdings&customName=suggested__0YourPortfolio&duration=15&startDate=undefined&endDate=undefined"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "ft.testing.acct@gmail.com", "fttestpasword"
WinHttpReq.Send

myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "c:\temp\testing.csv ", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub

有人能指出我正确的方向,为什么我没有登录/没有获得完整的csv文件?

1 个答案:

答案 0 :(得分:2)

我注意到你的代码的第一件事是密码错过了" s"。然后当你在网址中有一个奇怪的长号码是因为生成网址需要某种身份验证,并且#34; 3415c458-40bf-4e63-903a-37302a88bd83"

当发生这种情况时,您需要找到登录网址,然后使用" POST"验证数据的方法。完成后,您可以发送常规" GET"请求和数据将显示。

Sub downloadingpositions()

    Const strLOGING_URL As String = "https://registration.ft.com/registration/barrier/login?username=ft.testing.acct@gmail.com&password=fttestpassword"
    Const strPORTFOLIO_URL As String = "http://portfolio.ft.com/PortfolioAPI/ExportToCSV?containerID=3415c458-40bf-4e63-903a-37302a88bd83&type=Holdings&customName=suggested__0YourPortfolio&duration=15&startDate=undefined&endDate=undefined"
    Const strINCORRECT_CREDENTIALS As String = "Your email address and password do not match our records"
    Const strFILE_NAME As String = "c:\temp\testing.csv"

    Dim WinHttpReq As Object
    Dim oStream As Object

    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    ' Post to the url to set the credentials
    WinHttpReq.Open "POST", strLOGING_URL, 0
    WinHttpReq.Send


    ' Make sure authetication went through
    If Not UCase$(WinHttpReq.ResponseText) Like "*" & UCase$(strINCORRECT_CREDENTIALS) & "*" Then

        ' Get the information.
        WinHttpReq.Open "GET", strPORTFOLIO_URL, 0
        WinHttpReq.Send

        ' If we have succedeed then write the response to the file.
        If WinHttpReq.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write WinHttpReq.ResponseBody
            oStream.SaveToFile strFILE_NAME, 2    ' 1 = no overwrite, 2 = overwrite
            oStream.Close
        End If

    Else
        MsgBox strINCORRECT_CREDENTIALS, vbOKOnly + vbCritical, "Error"
    End If

End Sub

我希望这会有所帮助:)