WEB查詢改成XMLHTTP

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

WED查詢.zip (280 KB)

樓主熱帖

Scott090

高中生 Rank: 3 Rank: 3

帖子: 519
主題: 54
精華: 0
積分: 595
點名: 250
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-11-15

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

2^#

發表於 2019-3-3 11:40 | 只看該作者

回復 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

TOP

BANK870

中學生 Rank: 2

帖子: 9
主題: 5
精華: 0
積分: 63
點名: 0
作業系統: WINDONW
軟體版本: 8
閱讀權限: 20
性別: 男
註冊時間: 2014-12-13
最後登錄: 2024-1-3

3^#

發表於 2019-3-3 17:19 | 只看該作者

謝謝大大請問大大這段語法我有點不懂可以教我嗎?
      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

TOP

Scott090

高中生 Rank: 3 Rank: 3

帖子: 519
主題: 54
精華: 0
積分: 595
點名: 250
作業系統: win 10
軟體版本: []
閱讀權限: 50
性別: 男
註冊時間: 2013-3-19
最後登錄: 2024-11-15

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章 2015羊年全勤獎章

4^#

發表於 2019-3-4 12:15 | 只看該作者

回復 3# BANK870

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

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

      以上請參考

TOP