iT邦幫忙

0

請問一下,書本上的程式碼要抓yahoo主力進出,但是在set table那一行執行的時候顯示此處需要物件,該怎麼解決呢?小弟我也不知道哪裡寫錯,求各位大師指導

Sub iecss_yahoo股市台積電主力進出()
    Const url As String = "https://tw.stock.yahoo.com/d/s/major_2330.html"
    Dim i As Integer, j As Integer
    Dim ie As Object, table As Object
    Set ie = CreateObject("internetexplorer.application")
    With ie
        .Visible = False
        .Navigate url
        Do While .busy Or .readystate <> 4
            DoEvents
        Loop
        Do
            DoEvents
        Loop Until .document.readystate = "complete"
        
        Set table = .document.querySelectorall("table table").Item(2)
        With Sheets(1)
            For i = 0 To table.Rows.Length - 1
                For j = 0 To table.Rows(i).Cells.Length - 1
                    .Cells(i + 1, j + 1) = table.Rows(i).Cells(j).innerText
                Next
            Next
        End With
        Set table = .document.querySelectorall("table+table").Item(0)
        With Sheets(1)
            For i = 0 To table.Rows.Length - 1
                For j = 0 To table.Rows(i).Cells.Length - 1
                    .Cells(i + 3, j + 1) = table.Rows(i).Cells(j).innerText
                Next
            Next
        End With
        .Quit
    End With
    Set table = Nothing
    Set ie = Nothing
End Sub
Sub xmlhttp_yahoo股市台積電()
    Const url As String = "https://tw.stock.yahoo.com/q/q?s=2330"
    Dim i As Integer, j As Integer
    Dim dom As Object, table As Object, xmlhttp As Object
    Set xmlhttp = CreateObject("Microsoft.xmlhttp")
    Set dom = CreateObject("htmlfile")
    With xmlhttp
        .Open "Get", url, False
        .Send
        If .Status = 200 Then
            dom.body.innerhtml = .responsetext
        End If
    End With
    Set table = dom.getelementsbytagname("table")(2)
    With Sheets(1)
        For Each Row In table.Rows
            j = 0
            For Each Col In Row.Cells
                .Cells(i + 1, j + 1) = Col.innerText
                j = j + 1
            Next
            i = i + 1
        Next
    End With
    Set table = Nothing
    Set dom = Nothing
    Set xmlhttp = Nothing
    
End Sub

https://ithelp.ithome.com.tw/upload/images/20200710/20128213Q9cpQ12sqZ.png

1 個回答

2
海綿寶寶
iT邦大神 1 級 ‧ 2020-07-11 09:16:06
最佳解答

Item(2)改成Item(1)

Sub iecss_yahoo股市台積電主力進出()
    Const url As String = "https://tw.stock.yahoo.com/d/s/major_2330.html"
    Dim i As Integer, j As Integer
    Dim ie As Object, table As Object
    Set ie = CreateObject("internetexplorer.application")
    With ie
        .Visible = False
        .Navigate url
        Do While .busy Or .readystate <> 4
            DoEvents
        Loop
        Do
            DoEvents
        Loop Until .document.readystate = "complete"
        
        Set table = .document.querySelectorall("table table").Item(1)
        With Sheets(1)
            For i = 0 To table.Rows.Length - 1
                For j = 0 To table.Rows(i).Cells.Length - 1
                    .Cells(i + 1, j + 1) = table.Rows(i).Cells(j).innerText
                Next
            Next
        End With
        Set table = .document.querySelectorall("table+table").Item(0)
        With Sheets(1)
            For i = 0 To table.Rows.Length - 1
                For j = 0 To table.Rows(i).Cells.Length - 1
                    .Cells(i + 3, j + 1) = table.Rows(i).Cells(j).innerText
                Next
            Next
        End With
        .Quit
    End With
    Set table = Nothing
    Set ie = Nothing
End Sub
Sub xmlhttp_yahoo股市台積電()
    Const url As String = "https://tw.stock.yahoo.com/q/q?s=2330"
    Dim i As Integer, j As Integer
    Dim dom As Object, table As Object, xmlhttp As Object
    Set xmlhttp = CreateObject("Microsoft.xmlhttp")
    Set dom = CreateObject("htmlfile")
    With xmlhttp
        .Open "Get", url, False
        .Send
        If .Status = 200 Then
            dom.body.innerHTML = .responsetext
        End If
    End With
    Set table = dom.getelementsbytagname("table")(2)
    With Sheets(1)
        For Each Row In table.Rows
            j = 0
            For Each Col In Row.Cells
                .Cells(i + 1, j + 1) = Col.innerText
                j = j + 1
            Next
            i = i + 1
        Next
    End With
    Set table = Nothing
    Set dom = Nothing
    Set xmlhttp = Nothing
    
End Sub
iannnn iT邦新手 5 級 ‧ 2020-07-11 11:10:48 檢舉

謝謝你~

我要發表回答

立即登入回答