返回列表 上一主題 發帖

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

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

[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

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

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

  23.             Debug.Print v

  24. End With
  25.     With ie  'IE視窗最大化
  26.         Application.WindowState = xlMaximized
  27.         .Height = Application.Height
  28.         .Width = Application.Width
  29.         .Quit
  30.     End With
  31. End Sub

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

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

  52.         With 工作表2
  53.             .UsedRange.Clear
  54.             For i = 0 To S.Rows.Length - 1      '寫入資料
  55.                 k = k + 1
  56.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  57.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  58.                     DoEvents
  59.                     Next
  60.             Next
  61.         End With
  62.     End With
  63. End Sub

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

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

  77.                 Exit Do
  78.               End If
  79.         Loop
  80.         Do
  81.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  82.         Loop Until Not S Is Nothing

  83.         With 工作表3
  84.             .UsedRange.Clear
  85.             For i = 0 To S.Rows.Length - 1      '寫入資料
  86.                 k = k + 1
  87.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  88.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  89.                     DoEvents
  90.                     Next
  91.             Next
  92.         End With
  93.     End With
  94. End Sub


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

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

  102.     With ie
  103.         .Navigate rr
  104.         Do While .readyState <> 4                          '等待網頁下載完畢
  105.               DoEvents
  106.               If Time >= T + #12:00:03 AM# Then
  107.                 DoEvents
  108.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  109.                
  110.                 Exit Do
  111.               End If
  112.         Loop
  113.         Do
  114.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  115.         Loop Until Not S Is Nothing

  116.         With 工作表4
  117.             .UsedRange.Clear
  118.             For i = 0 To S.Rows.Length - 1      '寫入資料
  119.                 k = k + 1
  120.                 'For j = 0 To S.Rows(i).Length - 1  '這行是錯誤的 也是多餘的迴圈
  121.                    '用 On Error Resume Next 使程式繼續執行
  122.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  123.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  124.                     DoEvents
  125.                     Next
  126.                 'Next
  127.             Next
  128.         End With
  129.     End With
  130. End Sub

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

  132.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  133.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  134.     T = Time
  135.    
  136.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcp/zcpb/zcpb_" & ss & ".djhtm"
  137.     With ie
  138.         .Navigate rr
  139.         Do While .readyState <> 4                          '等待網頁下載完畢
  140.               DoEvents
  141.               If Time >= T + #12:00:03 AM# Then
  142.                 DoEvents
  143.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  144.                
  145.                 Exit Do
  146.               End If
  147.         Loop
  148.         Do
  149.         Set S = .Document.getElementsByTagName("table")(2) ' 新的 table 4
  150.         Loop Until Not S Is Nothing


  151.         With 工作表5
  152.             .UsedRange.Clear
  153.             For i = 0 To S.Rows.Length - 1      '寫入資料
  154.                 k = k + 1
  155.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  156.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  157.                     DoEvents
  158.                     Next
  159.             Next
  160.         End With
  161.     End With
  162. End Sub
  163. Private Sub GetShareholding(ByVal ss As String)     '取董監持股網頁

  164.     Dim rr As String, T As Date, i, ii, k, j, S As Object
  165.     'On Error Resume Next '程式的執行沒有預期的錯誤,此行可不用.
  166.     T = Time
  167.     rr = "http://pscnetinvest.moneydj.com.tw/z/zc/zcj/zcj_" & ss & ".djhtm"     '取董監持股網頁
  168.     With ie
  169.         .Navigate rr
  170.         Do While .readyState <> 4                          '等待網頁下載完畢
  171.               DoEvents
  172.               If Time >= T + #12:00:03 AM# Then
  173.                 DoEvents
  174.                 Application.SendKeys "~"                    '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
  175.                
  176.                 Exit Do
  177.               End If
  178.         Loop
  179.         Do
  180.         Set S = .Document.getElementsByTagName("table")(3) ' 新的 table 4
  181.         Loop Until Not S Is Nothing

  182.         With 工作表6
  183.             .UsedRange.Clear
  184.             For i = 0 To S.Rows.Length - 1      '寫入資料
  185.                 k = k + 1
  186.                     For ii = 0 To S.Rows(i).Cells.Length - 1  ' S.Rows(i).Cells.Length - 1 才是正確
  187.                     .Cells(k, ii + 1) = S.Rows(i).Cells(ii).innerText
  188.                     DoEvents
  189.                     Next
  190.             Next
  191.         End With
  192.     End With
  193. End Sub
複製代碼

測試檔.rar (17.16 KB)

回復 1# wufonna


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

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

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

測試檔.rar (20.55 KB)

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

TOP

本帖最後由 wufonna 於 2018-11-6 12:55 編輯

回復 2# faye59

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

測試檔2.rar (163.44 KB)

TOP

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

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

回復 5# wufonna


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

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題