从 Investing.com 下载 CSV 文件

Question

我想从此链接下载 CSV 文件： https://it.investing.com/rates-bonds/it0005583486-historical-data 我将 Selenium 与 Excel 结合使用，并设法输入用户名和密码，但是当我到达“下载 (CSV)”按钮时，我就卡住了。 我哪里错了？下面是 HTML 代码和我的宏。

  With dD
        '.Start
        .Get Url
        ' clicca "accetta"
        dD.FindElementByXPath("//*[@id='onetrust-button-group-parent']").Click
        Application.Wait (Now + TimeValue("00:00:02"))

        '----------------------------------------  Login ---------------------------------------

        ' accedi

        Set Btn = dD.FindElementByXPath("/html/body/div[1]/header/div[1]/section/div[3]/ul/li[1]/button/span")
        Btn.Click

        ' accedi tramite mail
        Set btn1 = dD.FindElementByXPath("/html/body/div[4]/div/div/form/button[4]/span")
        btn1.Click


        ' inserisce user
        .FindElementByXPath("//*[@id=':rb:']/form/div[3]/input").SendKeys myUser


        'inserisce password
        .FindElementByXPath("//*[@id=':rb:']/form/div[5]/input").SendKeys myPassword

        ' conferma pulsante accedi

        Set btn2 = dD.FindElementByXPath("//*[@id=':rb:']/form/button/span")
        btn2.Click
        Application.Wait (Now + TimeValue("00:00:01"))
        
        ' pulsante accedi
        Set btn3 = dD.FindElementByXPath("/html/body/div[4]/div/div/form/button")
        btn3.Click
        Application.Wait (Now + TimeValue("00:00:10"))

    '--------------------------------------------- here the error

       '//*[@id="__next"]/div[2]/div[2]/div[2]/div[1]/div[3]/div[2]/div[2]/div[1]/div/span[2]
        Set btn4 = dD.FindElementByXPath("//*[@id='__next']/div[2]/div[2]/div[2]/div[1]/div[3]/div[2]/div[2]/div[1]/div/span[2]")
       btn4.Click

       ' Set btn4 = dD.FindElementByCss("span.text-center:nth-child(2)")
        ' btn4.Click
        
 '------------------------------------------------------------
                   fName = myIsin & ".csv"
                   mioFile = Percorso & fName
                  .SaveAs Filename:=mioFile, Local:=False, CreateBackup:=False

    End With
    dD.Quit
    Call ConvertiCSV

    Set dD = Nothing
    Set wks = Nothing
    Set Wks1 = Nothing
End Sub

在此输入图片描述

我想下载 csv 文件。

Answer 1

您可以尝试我下面的代码，它不使用

Selenium

，所以它更可靠。

您可以更改 URL 中的开始日期和结束日期，或者您可以从工作表上的 2 个单元格获取日期。

这是代码；

Sub GetData()
    Dim URL As String, objXMLHTTP As Object, strCOOKIE As String
    Dim strJSON As String, regExp As Object, arrPattern(1 To 7) As Variant, xPattern As Variant
    Dim r As Integer, c As Integer, RetVal As Object, objList As ListObject
    
    URL = "https://it.investing.com/rates-bonds/it0005583486-historical-data"
    
    Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    objXMLHTTP.Open "HEAD", URL, False
    objXMLHTTP.send
    
    strCOOKIE = Split(Split(objXMLHTTP.getResponseHeader("Set-Cookie"), ";")(0), "=")(1)
    strCOOKIE = Mid(strCOOKIE, 1, Len(strCOOKIE) - 1)
    
    URL = "https://api.investing.com/api/financialdata/historical/1212094?start-date=2024-11-14&end-date=2024-12-14&time-frame=Daily&add-missing-rows=false"
    
    With objXMLHTTP
      .Open "GET", URL, False
      .setRequestHeader "Cookie", strCOOKIE
      .setRequestHeader "Content-Type", "application/x-www"
      .setRequestHeader "Origin", "https://it.investing.com/"
      .setRequestHeader "Domain-Id", "it"
      .send
    End With
        
    If objXMLHTTP.Status = 200 Then
        Range("A1:G" & Rows.Count) = ""
        Range("A1:G1") = Array("Date", "Last Close", "Last Open", "Last Max", "Last Min", "Volume", "Change (%)")
    
        strJSON = objXMLHTTP.responseText
            
        arrPattern(1) = """rowDate"":""(.+?)"","
        arrPattern(2) = """last_close"":""(.+?)"","
        arrPattern(3) = """last_open"":""(.+?)"","
        arrPattern(4) = """last_max"":""(.+?)"","
        arrPattern(5) = """last_min"":""(.+?)"","
        arrPattern(6) = """volume"":""(.+?)"","
        arrPattern(7) = """change_precent"":""(.+?)"","
        
        Set regExp = CreateObject("VBScript.RegExp")
    
        regExp.ignorecase = True
        regExp.Global = True
    
        For Each xPattern In arrPattern
            regExp.Pattern = xPattern
            r = 1
            c = c + 1
            If regExp.Test(strJSON) Then
                For Each RetVal In regExp.Execute(strJSON)
                    r = r + 1
                    Cells(r, c) = RetVal.Submatches(0)
                Next
            End If
        Next
        
        Set objList = ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange)
        
        With objList
            .Name = "List_Investing"
            .Range.Columns.AutoFit
        End With
        
        MsgBox "Done...!", vbInformation
    Else
        MsgBox "URL problem...."
    End If
    
    Set regExp = Nothing
    Set objXMLHTTP = Nothing
End Sub