VBA从网站下载CSV

时间:2018-05-16 14:12:46

标签: vba excel-vba excel

我正在努力学习我编写的VBA脚本。从网站下载4个不同的csv文件被称为4次。如果我按F8逐步执行脚本,它可以正常工作。但是,当我运行整个脚本时,它不会下载所有文件。有时它会下载一两个文件,有时甚至是不可预测的!?有没有人知道Sub DownloadIshares()的代码有什么问题?

非常感谢提前

Sub Test()
DownloadIshares "EUN5"
DownloadIshares "IBCS"
DownloadIshares "LQDH"
DownloadIshares "SDIG"
End Sub

Sub DownloadIshares(inETFName As String)

Dim o_IE As InternetExplorer
Dim FSO As FileSystemObject
Dim o_TextStream As TextStream
Dim HTMLDoc As HTMLDocument
Dim urlETF As String
Dim links As IHTMLElementCollection
Dim link As HTMLAnchorElement
Dim WB_tmp As Workbook
Dim MainPath As String, MainUrl_1 As String, MainUrl_2 As String, UrlETF_No As String
Dim SearchForLink As String

MainPath = "U:\Entwicklung\Instrumentenabgleich_ETF\"
MainUrl_1 = "https://www.ishares.com/de/professionelle-anleger/de/site-entry?siteEntryAction=ACCEPT&targetUrl" _
    & "=%2Fde%2Fprofessionelle-anleger%2Fde%2Fprodukte%2F"
MainUrl_2 = "%2F%3FsiteEntryPassthrough%3Dtrue%26refer" _
    & "rer%3DtickerSearch%26locale%3Dde_DE%26userType%3Dinstitutional"

Select Case inETFName
    Case "EUN5"
        UrlETF_No = "251726"
        SearchForLink = "_Datenblatt_GroMiKV_IE00BF11F565.csv"
    Case "LQDH"
        UrlETF_No = "257320"
        SearchForLink = "_Datenblatt_GroMiKV_IE00BCLWRB83.csv"
    Case "IBCS"
        UrlETF_No = "251565"
        SearchForLink = "_Datenblatt_GroMiKV_IE0032523478.csv"
    Case "SDIG"
        UrlETF_No = "258126"
        SearchForLink = "_Datenblatt_GroMiKV_IE00BYXYYP94.csv"
End Select

urlETF = MainUrl_1 & UrlETF_No & MainUrl_2
Set FSO = New FileSystemObject
Set o_IE = New InternetExplorer
o_IE.Visible = True
'o_IE.Visible = False

o_IE.Navigate urlETF
Do While o_IE.Busy Or o_IE.readyState <> 4
    DoEvents
Loop

Set HTMLDoc = o_IE.Document
Set links = HTMLDoc.getElementsByTagName("A")
For Each link In links
    'If InStr(link.href, "_Datenblatt_GroMiKV_IE00BCLWRB83.csv") Then
    If InStr(link.href, SearchForLink) > 0 Then
        Debug.Print "Text: " & link.innerText & vbCr & "URL: " & link.href
        'Set o_TextStream = FSO.OpenTextFile(link.href)
        Set WB_tmp = Workbooks.Open(link.href)
        WB_tmp.SaveAs MainPath & inETFName, xlCSV
        Application.DisplayAlerts = False
        WB_tmp.Close
        Application.DisplayAlerts = True
    End If
Next

End Sub

1 个答案:

答案 0 :(得分:0)

我认为您可以大量简化代码!

Sub OpenCSV()
strURL = "https://d396qusza40orc.cloudfront.net/getdata%2Fdata%2Fss06hid.csv"
Application.Workbooks.Open (strURL)
End Sub