OleHenrikSkogstrøm在帖子中发布了一个回复:“我如何使用VBA下载文件(没有Internet Explorer)”。
使用他的代码,因为我希望从www.ft.com下载csv文件并将其保存到我的c盘上的临时文件中。我不是经常需要这样做,所以我决定使用简单的excel VBA。我在www.FT.com上设置了一个临时测试订阅帐户,以说明我要下载的内容,用户名是“ft.testing.acct@gmail.com”,密码是“fttestpassword”。
登录后,可以在页面的右上角看到“导出数据”链接:
点击此链接时传递的网址为:
以下代码返回一个文件,但是该文件中只有“{”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文件?
答案 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
我希望这会有所帮助:)