20180226xlVbaGetStockData

Sub LoopGetStockData()

Dim StartTime As Variant

    Dim UsedTime As Variant

    StartTime = VBA.Timer

    Cells.ClearContents

    For y = 2017 To 2007 Step -1

        For s = 4 To 1 Step -1

            GetStockData "600000", y, s

        Next s

    Next

UsedTime = VBA.Timer - StartTime

    Debug.Print "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")

   'MsgBox "UsedTime ：" & Format(UsedTime, "#0.0000 Seconds")

End Sub

Sub GetStockData(ByVal StockNo As String, ByVal YearNo As String, ByVal SeasonNo As String)

    URL = "http://xxx.com/trade/lsjysj_" & StockNo & ".html?year=" & YearNo & "&season=" & SeasonNo

    '发送请求

    With CreateObject("WinHttp.WinHttpRequest.5.1")

        ' With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", URL, False

        .setRequestHeader "Content-Type", "text/html"

        .Send

        WebText = .responsetext

        'Debug.Print WebText

        'Range("A1").Value = WebText

    End With

    Dim OneTable As Object

    Dim OneTh As Object

    Dim OneTr As Object

    Dim tHead As Object

    Dim tBody As Object

    Dim r As Long, c As Long

    With CreateObject("htmlfile")

        .write WebText

        Set OneTable = .getElementsByTagName("table")(3)

        r = Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1

        If r = 2 Then r = 1

        Set tHead = OneTable.FirstChild

        Set tr = tHead.FirstChild

        c = 0

        If r = 1 Then

            For Each OneTh In tr.ChildNodes

                c = c + 1

                Cells(r, c).Value = OneTh.innerText

            Next OneTh

        End If

        Set tBody = tHead.NextSibling

        For Each OneTr In tBody.ChildNodes

            r = r + 1

            c = 0

            For Each td In OneTr.ChildNodes

                c = c + 1

                Cells(r, c).Value = td.innerText

            Next td

        Next OneTr

    End With

    Set OneTable = Nothing

    Set OneTh = Nothing

    Set OneTr = Nothing

    Set tHead = Nothing

    Set tBody = Nothing

End Sub