返回列表 上一主題 發帖

[發問] 請教 大大 這程式是那個地方出現問題，謝謝

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2022-2-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-11-5 12:43 | 只看該作者

[發問] 請教 大大 這程式是那個地方出現問題，謝謝

[attach]29643[/attach]
請教 大大 這程式是那個地方出現問題，謝謝
工作表3就只複製工作表2的網
  1. Option Explicit
  2. Dim ie As Object   '模組最頂端 Dim 供這模組的程序使用的變數
  3. Sub AllFile()
  4.     Dim i As Integer, v, Y As Integer, S As String
  5.     Set ie = CreateObject("internetexplorer.application")   '使用此方式可以免除 "設定引用項目"
  6.     With ie '縮小IE視窗
  7.         .Visible = True
  8.         .Width = 5
  9.         .Height = 5
  10.     End With

  12.     With 工作表1
  13.       Dim AR
  14.         AR = .Range("E1:M1")
  15.         .Range("E:M") = ""
  16.         .Range("E1:M1") = AR

  18. '        .Range("E2").CurrentRegion = ""            '清除工作表1,年度範圍
  19.     v = "2330"
  20.           GetDividend (v)
  21.            GetClosePrice (v)
  22.            GetIncome (v)
  23.            GetBalance (v)
  24.            GetShareholding (v)

  26.             Debug.Print v

  28. End With
  29.     With ie  'IE視窗最大化
  30.         Application.WindowState = xlMaximized
  31.         .Height = Application.Height
  32.         .Width = Application.Width
  33.         .Quit
  34.     End With
  35. End Sub

  37. Private Sub GetDividend(ByVal ss As String)     '取股利網頁

  39.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  40.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  41.     T = Time
  42.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcc/zcc_" & ss & ".djhtm"
  43.     With ie
  44.         .Navigate rr
  45.         Do While .readyState <> 4                          '等待網頁下載完畢
  46.               DoEvents
  47.               If Time >= T + #12:00:03 AM# Then
  48.                 DoEvents
  49.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  50.                
  51.                
  52.                 Exit Do
  53.               End If
  54.         Loop
  55.         Do
  56.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  57.         Loop Until Not S Is Nothing

  59.         With 工作表2
  60.             .UsedRange.Clear
  61.             For i = 0 To S.Rows.Length - 1      '寫入資料
  62.                 k = k + 1
  63.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  64.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  65.                     DoEvents
  66.                     Next
  67.             Next
  68.         End With
  69.     End With
  70. End Sub

  72. Private Sub GetClosePrice(ByVal ss As String) ' 取基本資料

  74.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  75.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  76.     T = Time
  77.     'rr = "http://dj.mybank.com.tw/z/zc/zca/zca_" & ss & ".asp.htm" '取(基本資料) 收盤價 本益比 負債比 網頁
  78.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zca/zca_" & ss & ".djhtm"
  79.     With ie
  80.         .Navigate rr
  81.         Do While .readyState <> 4                          '等待網頁下載完畢
  82.               DoEvents
  83.               If Time >= T + #12:00:03 AM# Then
  84.                 DoEvents
  85.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號

  87.                 Exit Do
  88.               End If
  89.         Loop
  90.         Do
  91.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  92.         Loop Until Not S Is Nothing

  94.         With 工作表3
  95.             .UsedRange.Clear
  96.             For i = 0 To S.Rows.Length - 1      '寫入資料
  97.                 k = k + 1
  98.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  99.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  100.                     DoEvents
  101.                     Next
  102.             Next
  103.         End With
  104.     End With
  105. End Sub


  108. Private Sub GetIncome(ByVal ss As String)     '取損益表(年表)網頁

  110.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  111.     T = Time
  112.     'rr = "http://yamstock.megatime.com.tw/asp/stockinfo/GetReport.asp?Select_Table=html\YFinain\&StockID=" & ss     '取損益表(年表)網頁
  113.    
  114.    
  115.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcq/zcqa_" & ss & ".djhtm"

  117.     With ie
  118.         .Navigate rr
  119.         Do While .readyState <> 4                          '等待網頁下載完畢
  120.               DoEvents
  121.               If Time >= T + #12:00:03 AM# Then
  122.                 DoEvents
  123.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  124.                
  125.                 Exit Do
  126.               End If
  127.         Loop
  128.         Do
  129.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  130.         Loop Until Not S Is Nothing

  132.         With 工作表4
  133.             .UsedRange.Clear
  134.             For i = 0 To S.Rows.Length - 1      '寫入資料
  135.                 k = k + 1
  136.                 'For j = 0 To S.Rows(i).Length - 1  '這行是錯誤的 也是多餘的迴圈
  137.                    '用 On Error Resume Next 使程式繼續執行
  138.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  139.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  140.                     DoEvents
  141.                     Next
  142.                 'Next
  143.             Next
  144.         End With
  145.     End With
  146. End Sub

  148. Private Sub GetBalance(ByVal ss As String)     '取資產負債表(年表)網頁

  150.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  151.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  152.     T = Time
  153.    
  154.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcp/zcpb/zcpb_" & ss & ".djhtm"
  155.     With ie
  156.         .Navigate rr
  157.         Do While .readyState <> 4                          '等待網頁下載完畢
  158.               DoEvents
  159.               If Time >= T + #12:00:03 AM# Then
  160.                 DoEvents
  161.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  162.                
  163.                 Exit Do
  164.               End If
  165.         Loop
  166.         Do
  167.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  168.         Loop Until Not S Is Nothing


  171.         With 工作表5
  172.             .UsedRange.Clear
  173.             For i = 0 To S.Rows.Length - 1      '寫入資料
  174.                 k = k + 1
  175.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  176.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  177.                     DoEvents
  178.                     Next
  179.             Next
  180.         End With
  181.     End With
  182. End Sub
  183. Private Sub GetShareholding(ByVal ss As String)     '取董監持股網頁

  185.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  186.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  187.     T = Time
  188.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcj/zcj_" & ss & ".djhtm"     '取董監持股網頁
  189.     With ie
  190.         .Navigate rr
  191.         Do While .readyState <> 4                          '等待網頁下載完畢
  192.               DoEvents
  193.               If Time >= T + #12:00:03 AM# Then
  194.                 DoEvents
  195.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  196.                
  197.                 Exit Do
  198.               End If
  199.         Loop
  200.         Do
  201.         Set S = .Document.getElementsByTagName("table")(3) ' 新的 table 4
  202.         Loop Until Not S Is Nothing

  204.         With 工作表6
  205.             .UsedRange.Clear
  206.             For i = 0 To S.Rows.Length - 1      '寫入資料
  207.                 k = k + 1
  208.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  209.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  210.                     DoEvents
  211.                     Next
  212.             Next
  213.         End With
  214.     End With
  215. End Sub
複製代碼

測試檔.rar (17.16 KB)

收藏 分享

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2018-11-6 00:40 | 只看該作者
回復 1# wufonna


    研究了一下，
本來想照我的方式重寫，
看了覺得有點麻煩...(不好意思)
所以直接改你的版本。

如果沒猜錯的話是你的私用程序沒有跟上網頁資料，
所以有不同步的地方才導致"沒有權限" ".Navigate視窗失敗"...等狀況
我把你每個程序都改成新開啟網頁(為了找盲點)，
然後已經連續執行10次都沒有跳出錯誤訊息。
記得以前我也碰過類似問題(怎麼修正的也忘了)，
大概修一修編寫邏輯就好了。
你在自己看一下。

另外我把你網頁最小化改成背景執行Web。
(確保程序沒錯在False，測試中請True，否則中斷程式後從工作管理員手動關閉背景殘留IE)

測試檔.rar (20.55 KB)

一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2022-2-16 
3#
發表於 2018-11-6 12:53 | 只看該作者
本帖最後由 wufonna 於 2018-11-6 12:55 編輯

回復 2# faye59

謝謝 faye 大，還是會出錯，就是大大說的 Navigate錯，本來在舊版的ＩＥ上可執行，升級IE後就會錯誤。
這是原程式，麻煩 大大 看看。

擷取.JPG (27.96 KB)

擷取.JPG

測試檔2.rar (163.44 KB)

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2018-11-8 21:10 | 只看該作者
回復 3# wufonna


應該是一樣的問題...
  1. Set ie = CreateObject("internetexplorer.application")
複製代碼
每個Private程序都加入吧~

另外你的Alert訊息修改一下會更好，
我會用這個去控制訊息式窗:
  1. Set wshshell = CreateObject("wscript.shell")
  2. Do
  3.     ret = wshshell.AppActivate("網頁訊息")
  4. Loop Until ret = True
  5. Application.Wait Now + 2 / 86400
  6. ret = wshshell.AppActivate("網頁訊息")
  7.     If ret = True Then
  8.         ret = wshshell.AppActivate("網頁訊息")'"網頁訊息"這文字需要改成你警告視窗的Title
  9.         Application.Wait Now + 2 / 86400
  10.         wshshell.SendKeys "{enter}"
  11.     End If
  12. Application.Wait Now + 2 / 86400
  13. Do While .readystate <> 4 Or .busy: DoEvents: Loop
複製代碼
我記得這是麻辣家組某位先進提供的方式，
平常用不到，
但需要用上時真的很好用，
這段程式碼是先偵測警告訊息再把警告訊息置頂，
這樣在SendKeys "{enter}"能確保正確按下。
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2022-2-16 
5#
發表於 2018-11-15 14:16 | 只看該作者
回復 4# faye59

謝謝 大大
大大 這程式是忽略錯的嗎?
我改回ie8了
測試可能是 table 的頭包在form內不能執行   
http://pscnetinvest.moneydj.com.tw/z/zc/zcq/zcqa_2330.djhtm
這網頁沒包在內就可以
http://pscnetinvest.moneydj.com.tw/z/zc/zcq/zcqa0_2330.djhtm

用版主大 http://forum.twbts.com/thread-12273-1-1.html
的測試可以，請教可用 div 區塊嗎，因div 沒包在form內，還是是因別的原因，謝謝

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2018-11-16 20:28 | 只看該作者
回復 5# wufonna


    不是忽略錯誤哦!!
而是把Alert訊息選擇，
讓ENTER不會按錯地方。
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

wufonna

帖子
161 
主題
26 
精華
0 
積分
187 
點名
0  
作業系統
xp 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
TW 
註冊時間
2011-1-2 
最後登錄
2022-2-16 
7#
發表於 2019-1-15 21:13 | 只看該作者
放棄了還是找不到原因，用 GBKEE 超版大大 msxml2.xmlhttp 的方法可以用了，謝謝
http://forum.twbts.com/thread-21270-1-2.html
  1. Option Explicit

  3. Dim ie As Object   '模組最頂端 Dim 供這模組的程序使用的變數
  4. Sub AllFile()
  5.     Dim i As Integer, v, Y As Integer, S As String
  6.     Set ie = CreateObject("internetexplorer.application")   '使用此方式可以免除 "設定引用項目"
  7.     With ie '縮小IE視窗
  8.         .Visible = True
  9.         .Width = 5
  10.         .Height = 5
  11.     End With

  13.     With 工作表1
  14.       Dim AR
  15.         AR = .Range("E1:M1")
  16.         .Range("E:M") = ""
  17.         .Range("E1:M1") = AR

  19. '        .Range("E2").CurrentRegion = ""            '清除工作表1,年度範圍
  20.         For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  21.             v = .Cells(i, 1).Value
  22. '''''
  23.           GetDividend (v)
  24.            GetClosePrice (v)
  25.            GetIncome (v)
  26.            GetBalance (v)
  27.            GetShareholding (v)

  29.           .Cells(i, 5).Value = 工作表2.Cells(5, 2).Value
  30.           .Cells(i, 6).Value = 工作表2.Cells(5, 3).Value
  31.           .Cells(i, 7).Value = 工作表3.Cells(2, 8).Value
  32.           .Cells(i, 8).Value = .Cells(i, 5).Value / .Cells(i, 7).Value   '現金殖利率
  33.             On Error Resume Next
  34. '          .Cells(i, 8).NumberFormatLocal = "0.00%"
  35.           .Cells(i, 9).Value = 工作表4.Cells(66, 2).Value / 工作表5.Cells(94, 2).Value 'ROE%
  36.             On Error Resume Next
  37.           .Cells(i, 10).Value = 工作表3.Cells(4, 2).Value '本益比
  38.           .Cells(i, 11).Value = 工作表3.Cells(12, 4).Value '股價淨值比
  39.           .Cells(i, 12).Value = 工作表3.Cells(11, 4).Value '負債比%
  40. '          .Cells(i, 12).NumberFormatLocal = "0.00%"
  41.           .Cells(i, 13).Value = 工作表6.Cells(3, 4).Value '董監持股%
  42. '          .Cells(i, 13).NumberFormatLocal = "0.00%"


  45.             Debug.Print v
  46.         Next
  47.     End With
  48.     With ie  'IE視窗最大化
  49.         Application.WindowState = xlMaximized
  50.         .Height = Application.Height
  51.         .Width = Application.Width
  52.         .Quit
  53.     End With
  54. End Sub

  56. Public Function MyFile(v As Integer, i As Integer)
  57.   '   Dim i As Integer, v, Y As Integer, S As String
  58.     Set ie = CreateObject("internetexplorer.application")   '使用此方式可以免除 "設定引用項目"
  59.     With ie '縮小IE視窗
  60.         .Visible = True
  61.         .Width = 5
  62.         .Height = 5
  63.     End With
  64.     With 工作表1
  65.            .Range("E" & v & ":M" & v) = ""
  66. '        .Range("E2").CurrentRegion = ""            '清除工作表1,年度範圍
  67.             v = .Cells(i, 1).Value

  69.            GetDividend (v)
  70.            GetClosePrice (v)
  71.            GetIncome (v)
  72.            GetBalance (v)
  73.            GetShareholding (v)

  75.           .Cells(i, 5).Value = 工作表2.Cells(5, 2).Value
  76.           .Cells(i, 6).Value = 工作表2.Cells(5, 3).Value
  77.           .Cells(i, 7).Value = 工作表3.Cells(2, 8).Value
  78.           .Cells(i, 8).Value = .Cells(i, 5).Value / .Cells(i, 7).Value   '現金殖利率
  79.             On Error Resume Next
  80. '          .Cells(i, 8).NumberFormatLocal = "0.00%"
  81.           .Cells(i, 9).Value = 工作表4.Cells(66, 2).Value / 工作表5.Cells(94, 2).Value 'ROE%
  82.             On Error Resume Next
  83.           .Cells(i, 10).Value = 工作表3.Cells(4, 2).Value '本益比
  84.           .Cells(i, 11).Value = 工作表3.Cells(12, 4).Value '股價淨值比
  85.           .Cells(i, 12).Value = 工作表3.Cells(11, 4).Value '負債比%
  86. '          .Cells(i, 12).NumberFormatLocal = "0.00%"
  87.           .Cells(i, 13).Value = 工作表6.Cells(3, 4).Value '董監持股%
  88. '          .Cells(i, 13).NumberFormatLocal = "0.00%"


  91.     End With

  93.     With ie  'IE視窗最大化
  94.         Application.WindowState = xlMaximized
  95.         .Height = Application.Height
  96.         .Width = Application.Width
  97.         .Quit
  98.     End With
  99. End Function

  101. Private Sub GetDividend(ByVal ss As String)     '取股利網頁
  102.   Dim strText As String
  103.   Dim i As Integer, j As Integer, xTable As Object
  104.   With CreateObject("msxml2.xmlhttp")
  105.     .Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zcc/zcc_" & ss & ".djhtm", False
  106.     .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  107.     .send
  108.     strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
  109.   End With
  110.   With CreateObject("htmlfile")
  111.         .Write strText
  112.         Set xTable = .all.tags("table")(2)
  113.         With 工作表2
  114.             .Cells.Clear
  115.             For i = 0 To xTable.Rows.Length - 1
  116.                 For j = 0 To xTable.Rows(i).Cells.Length - 1
  117.                     .Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
  118.                 Next
  119.             Next
  120.         End With
  121.   End With
  122. End Sub

  124. Private Sub GetClosePrice(ByVal ss As String) ' 取基本資料
  125.   Dim strText As String
  126.   Dim i As Integer, j As Integer, xTable As Object
  127.   With CreateObject("msxml2.xmlhttp")
  128.     .Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zca/zca_" & ss & ".djhtm", False
  129.     .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  130.     .send
  131.     strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
  132.   End With
  133.   With CreateObject("htmlfile")
  134.         .Write strText
  135.         Set xTable = .all.tags("table")(2)
  136.         With 工作表3
  137.             .Cells.Clear
  138.             For i = 0 To xTable.Rows.Length - 1
  139.                 For j = 0 To xTable.Rows(i).Cells.Length - 1
  140.                     .Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
  141.                 Next
  142.             Next
  143.         End With
  144.   End With
  145. End Sub


  148. Private Sub GetIncome(ByVal ss As String)     '取損益表(年表)網頁
  149.   Dim strText As String
  150.   Dim i As Integer, j As Integer, xTable As Object
  151.   With CreateObject("msxml2.xmlhttp")
  152.     .Open "GET", "http://kgieworld.moneydj.com/z/zc/zcq/zcqa/zcqa_" & ss & ".djhtm", False
  153.     .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  154.     .send
  155.     strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
  156.   End With
  157.   With CreateObject("htmlfile")
  158.         .Write strText
  159.         Set xTable = .all.tags("table")(2)
  160.         With 工作表4
  161.             .Cells.Clear
  162.             For i = 0 To xTable.Rows.Length - 1
  163.                 For j = 0 To xTable.Rows(i).Cells.Length - 1
  164.                     .Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
  165.                 Next
  166.             Next
  167.         End With
  168.   End With
  169. End Sub

  171. Private Sub GetBalance(ByVal ss As String)     '取資產負債表(年表)網頁
  172.   Dim strText As String
  173.   Dim i As Integer, j As Integer, xTable As Object
  174.   With CreateObject("msxml2.xmlhttp")
  175.     .Open "GET", "http://kgieworld.moneydj.com/z/zc/zcp/zcpb/zcpb_" & ss & ".djhtm", False
  176.     .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  177.     .send
  178.     strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
  179.   End With
  180.   With CreateObject("htmlfile")
  181.         .Write strText
  182.         Set xTable = .all.tags("table")(2)
  183.         With 工作表5
  184.             .Cells.Clear
  185.             For i = 0 To xTable.Rows.Length - 1
  186.                 For j = 0 To xTable.Rows(i).Cells.Length - 1
  187.                     .Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
  188.                 Next
  189.             Next
  190.         End With
  191.   End With
  192. End Sub
  193. Private Sub GetShareholding(ByVal ss As String)     '取董監持股網頁
  194.   Dim strText As String
  195.   Dim i As Integer, j As Integer, xTable As Object
  196.   With CreateObject("msxml2.xmlhttp")
  197.     .Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zcj/zcj_" & ss & ".djhtm", False
  198.     .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  199.     .send
  200.     strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
  201.   End With
  202.   With CreateObject("htmlfile")
  203.         .Write strText
  204.         Set xTable = .all.tags("table")(3)
  205.         With 工作表6
  206.             .Cells.Clear
  207.             For i = 0 To xTable.Rows.Length - 1
  208.                 For j = 0 To xTable.Rows(i).Cells.Length - 1
  209.                     .Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
  210.                 Next
  211.             Next
  212.         End With
  213.   End With
  214. End Sub
  215. Function BinToStr(arrBin, strChrs)
  216.     With CreateObject("ADODB.Stream")
  217.         .Type = 2
  218.         .Open
  219.         .Writetext arrBin
  220.         .Position = 0
  221.         .Charset = strChrs
  222.         BinToStr = .ReadText
  223.         .Close
  224.     End With
  225. End Function
複製代碼

TOP

        靜思自在 : 慈悲沒有敵人，智慧不起煩惱。
返回列表 上一主題