12
返回列表 上一主題 發帖

[發問] 請教網頁捉取的問題？ CreateObject("msxml2.xmlhttp") 的問題?

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2022-1-4 17:14 | 顯示全部帖子

[發問] 請教網頁捉取的問題？ CreateObject("msxml2.xmlhttp") 的問題?

請教網頁捉取的問題？ CreateObject("msxml2.xmlhttp") 的問題?
  1. Sub test() '取損益表(年表)網頁
  2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
  3. Set HTMLsourcecode = CreateObject("htmlfile")
  4. Set GetXml = CreateObject("msxml2.xmlhttp")
  5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
  6. With GetXml
  7. .Open "GET", Url, False
  8. .send

  10. ' Debug.Print .document.all(0).getElementsByTagName("div")(0).outerHTML
  11.   ' Debug.Print .document.all(0).getElementsByClassName("t11")(0).outerHTML
  12. ' Debug.Print .document.all(0).getElementsByClassName("table-row")(11).outerHTML
  13. '  Debug.Print .document.all(0).getElementsByClassName("t4t1 table-cell")(2).outerHTML
  14.   'Debug.Print .document.all(0).getElementsByClassName("t3n1 table-cell")(0).outerHTML
  15.   'Debug.Print .document.all(0).getElementsByClassName("t3n1 table-cell")(482).outerHTML
  16.   Debug.Print .document.all(0).getElementsByClassName("t3n1 table-cell")(482).innerHTML

  18. Debug.Print "test"
  19. End With
  20. Set HTMLsourcecode = Nothing '釋放記憶體
  21. Set GetXml = Nothing
  22. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複製代碼
請教大大，網頁改版，試修改程式，Debug.Print .document.all(0).getElementsByClassName("t3n1 table-cell")(482).innerHTML
用CreateObject("InternetExplorer.Application")可執行，用CreateObject("msxml2.xmlhttp") 會錯誤，請問如何修改，謝謝
收藏 分享

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
2#
發表於 2022-1-4 20:52 | 顯示全部帖子
我試著一個方法捉表格有更好的方法麻煩大大告知
Sub Test() '取損益表(年表)網頁
Dim Url, HTMLsourcecode, GetXml, TableG, i, j
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_2330.djhtm"
With GetXml
.Open "GET", Url, False
.Send

HTMLsourcecode.body.innerhtml = .Responsetext

' Debug.Print HTMLsourcecode.all.tags("div")(12).innertext
' Debug.Print HTMLsourcecode.all.tags("div")(15).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(15).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(400).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(482).innertext

'For i = 5 To 10
'  Debug.Print HTMLsourcecode.all.tags("div")(i).innertext
' Next i


For j = 0 To 300
  Debug.Print HTMLsourcecode.all.tags("span")(j).innertext
Next j
'
' Debug.Print HTMLsourcecode.all.tags("div")(5).innertext
' Debug.Print HTMLsourcecode.all.tags("div")(6).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(0).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(1).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(2).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(3).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(4).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(5).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(6).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(7).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(8).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(9).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(10).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(11).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(12).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(13).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(14).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(15).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(16).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(17).innertext
' Debug.Print HTMLsourcecode.all.tags("span")(18).innertext




End With
Set HTMLsourcecode = Nothing '釋放記憶體
Set GetXml = Nothing
End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
3#
發表於 2022-1-4 23:33 | 顯示全部帖子
回復 3# quickfixer


    謝謝 大大
就是這程式，最近網頁又改版了，捉不到 損益表 的質料，之前是 table,現在改為div內，無法捉表格。

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
4#
發表於 2022-1-4 23:59 | 顯示全部帖子
回復 3# quickfixer
請大大 可以貼上程式嗎？
我𧥾不到 01 ===>>> #1173
謝謝

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
5#
發表於 2022-1-5 00:03 | 顯示全部帖子
  1. Private Sub GetIncome(ByVal ss As String) '取損益表(年表)網頁
  2. Dim Url, HTMLsourcecode, GetXml, TableG, i, j
  3. Set HTMLsourcecode = CreateObject("htmlfile")
  4. Set GetXml = CreateObject("msxml2.xmlhttp")
  5. Url = "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_" & ss & ".djhtm"
  6. With GetXml
  7. .Open "GET", Url, False
  8. .Send

  10. HTMLsourcecode.body.innerhtml = .Responsetext
  11. Set TableG = HTMLsourcecode.all.tags("table")(2).Rows
  12. For i = 0 To TableG.Length - 1
  13. For j = 0 To TableG(i).Cells.Length - 1
  14. 工作表4.Cells(i + 1, j + 1) = TableG(i).Cells(j).innertext
  15. Next j
  16. Next i
  17. End With
  18. Set HTMLsourcecode = Nothing '釋放記憶體
  19. Set GetXml = Nothing
  20. End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
複製代碼
之前的捉不到

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
6#
發表於 2022-1-5 00:36 | 顯示全部帖子
回復 8# quickfixer


   找到了  謝謝 大大  我在試看看

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
7#
發表於 2022-1-5 01:16 | 顯示全部帖子
回復 1# wufonna
謝謝 大大 改好了

GetDividend-(2020-01-05).rar (56.16 KB)

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
8#
發表於 2022-1-6 19:01 | 顯示全部帖子
本帖最後由 wufonna 於 2022-1-6 19:04 編輯

回復 1# wufonna

金融保險業 別 的表格格式不一樣 抓不到正確的資料
我是取
ROE=損益表-稅前淨利(67)/資產負債表股-東權益總額(95)
.Cells(i, 9).Value = 工作表4.Cells(67, 2).Value / 工作表5.Cells(95, 2).Value 'ROE%
求改正方法 謝謝

附檔是抓到的資料

GetDividend-2022-1-6.rar (230.62 KB)

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
9#
發表於 2022-1-10 19:43 | 顯示全部帖子
回復 1# wufonna
  1. Sub test()
  2. Debug.Print "test"


  5. With Sheet1
  6.   Debug.Print .Columns("A").Find("稅前淨利").Row
  7.   Debug.Print .Range("b" & Sheet1.Columns("A").Find("稅前淨利").Row).Value
  8.   
  9.   Debug.Print .Rows("67").Find(-336).Column
  10.   Debug.Print .Rows("67").Find("-336").Column
  11.   Debug.Print .Rows("67").Find("52").Column
  12.             
  13.   Debug.Print .Rows("67").Find(0).Column '找到101內的0

  15. End With

  17. End Sub
複製代碼
紀錄一下

testest.rar (17.45 KB)

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2025-10-9 
10#
發表於 2022-1-11 02:19 | 顯示全部帖子
  1. '          .Cells(i, 9).Value = 工作表4.Cells(67, 2).Value / 工作表5.Cells(95, 2).Value 'ROE%
  2.            .Cells(i, 9).Value = 工作表4.Range("b" & 工作表4.Columns("A").Find("稅前淨利").Row).Value / 工作表5.Range("b" & 工作表5.Columns("A").Find("股東權益總額").Row).Value 'ROE% 不固定位子
複製代碼
回復 1# wufonna

修該片段

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。
12
返回列表 上一主題