WEB查詢改成XMLHTTP

BANK870

請問WED查詢如何改成XMLHTTP查詢

Scott090

回復 1# BANK870

    是這樣嗎?
   
    Sub byXMLhttp_Test()
      
      Dim sh As Worksheet
      Dim t!, i%, j%, k%
      Dim myXML As Object, myHTML As Object, myTable, URL$
      
      URL = "http://norway.twsthr.info/StockHolders.aspx?stock=1102"
       Set sh = Worksheets("Temp")
      Set myXML = CreateObject("Microsoft.XMLHTTP")
      Set myHTML = CreateObject("HTMLFile")
      
      t = timer
      With myXML
          .Open "GET", URL, False
            .setRequestHeader "Cache-Control", "no-cache"
            .setRequestHeader "Pragma", "no-cache"
          .send
          Do While .Status <> 200
             DoEvents
             If timer - t > 3 Then Exit Do
          Loop
          If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
           myHTML.body.innerHTML = .responsetext
      End With
      Set myTable = myHTML.getelementsbytagname("TABLE")(10)
      
      With myTable

            k = 1
            ReDim arDATA(.Rows.Length, .Rows(3).Cells.Length)
            
            For i = 1 To .Rows.Length
                  On Error Resume Next
                  For j = 3 To .Rows(3).Cells.Length
                        
                        arDATA(k, j - 2) = .Rows(i - 1).Cells(j - 1).innertext
                  Next
                  If Err.Number = 0 Then k = k + 1
            Next
            On Error GoTo 0
      End With

      sh.Cells.Clear
      sh.[A1].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA
      
      Set myXML = Nothing
      Set myHTML = Nothing
      Set myTable = Nothing
End Sub

BANK870

謝謝大大請問大大這段語法我有點不懂可以教我嗎?
        Do While .Status <> 200
             DoEvents
             If timer - t > 3 Then Exit Do
          Loop
          If .Status <> 200 Then MsgBox "No successful web connection", vbOKOnly: Exit Sub
           myHTML.body.innerHTML = .responsetext
      End With
      Set myTable = myHTML.getelementsbytagname("TABLE")(10)
      
      With myTable

            k = 1
            ReDim arDATA(.Rows.Length, .Rows(3).Cells.Length)
            
            For i = 1 To .Rows.Length
                  On Error Resume Next
                  For j = 3 To .Rows(3).Cells.Length
                        
                        arDATA(k, j - 2) = .Rows(i - 1).Cells(j - 1).innertext
                  Next
                  If Err.Number = 0 Then k = k + 1
            Next
            On Error GoTo 0
      End With

      sh.Cells.Clear
      sh.[A1].Resize(UBound(arDATA), UBound(arDATA, 2)) = arDATA

Scott090

回復 3# BANK870

       1. 回給對方時請按 "回復" 二字，對方才會收到帖子的信息
       2. 以下這一段是在等候資料是否已備妥，假如3秒內未備妥就先放棄，
            但這只是實驗，網頁方傳遞資料時期是不是給狀態信息這一件事還要學習。
           所以以下這一段可以刪除 試試看
           Do While .Status <> 200
                DoEvents
                If timer - t > 3 Then Exit Do
          Loop

       3. 網頁的這一個表資料列列間有橫隔線造成讀取資料錯誤，所以用 on error resume next 跳過讀取避免錯誤
      
         以上請參考