VBA使用登录名和密码从网站下载csv文件

Question

Ole Henrik Skogstrøm 善意地在帖子中回复:“How do i download a file using VBA (Without 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

点击此链接时传递的url是:

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 文件的正确方向吗？

Answer 1

关于您的代码，我注意到的第一件事是密码缺少“s”。然后，当您的网址中有一个奇怪的长数字时，是因为需要某种身份验证来生成网址“3415c458-40bf-4e63-903a-37302a88bd83”

发生这种情况时，您需要找到登录 URL，然后使用“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

我希望这有帮助:)