2014-03-27 104 views
3

Ole HenrikSkogstrøm在線程中發佈了一條回覆:「我如何使用VBA下載文件(無需Internet Explorer)」。VBA使用登錄名和密碼從網站下載csv文件

已使用他的代碼,因爲我希望從www.ft.com下載csv文件並將其保存到我的c驅動器上的臨時文件中。通常我不需要這樣做,所以我決定使用簡單的Excel VBA。我在www.FT.com上設置了一個臨時測試訂閱帳戶,以說明我想要下載的內容,用戶名是「[email protected]」,密碼是「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, "[email protected]", "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

我注意到你的代碼的第一件事是密碼缺少「s」。然後,當你在url中有一個奇怪的長號碼是因爲需要某種身份驗證來生成url「3415c458-40bf-4e63-903a-37302a88bd83」

當發生這種情況時,您需要找到登錄網址和然後使用「POST」方法驗證數據。一旦你完成了,那麼你可以發送常規的「GET」請求,數據將顯示。

Sub downloadingpositions() 

    Const strLOGING_URL As String = "https://registration.ft.com/registration/barrier/[email protected]&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 

我希望這有助於:)