Board logo

標題: [發問] 在網頁抽取資料時遇到「沒有使用權限」的問題 [打印本頁]
作者: 小俠客    時間: 2016-12-8 10:31     標題: 在網頁抽取資料時遇到「沒有使用權限」的問題

本帖最後由 小俠客 於 2016-12-8 10:33 編輯

以下是我在網站抽取資料時用的CODE
  1. Sub test()
  2. Dim http As Object, i As Integer

  4. Set http = CreateObject("InternetExplorer.Application")

  6. With http

  8. For i = 1 To 100

  10.     .Navigate "http://www.hkexnews.hk/sdw/search/search_sdw.asp"
  11.     .Visible = True
  12.     Do While .readyState <> 4
  13.         DoEvents
  14.     Loop
  15.    
  16.     .document.getelementbyid("ddlShareholdingDay").Value = 30
  17.     .document.getelementbyid("ddlShareholdingMonth").Value = 11
  18.     .document.getelementbyid("ddlShareholdingYear").Value = 2016
  19.     .document.getelementbyid("txtStockCode").Value = Format(Cells(i, 1), "00000")
  20.     .document.getelementbyid("btnSearch").Click
  21.    
  22.    
  23.     Do Until InStr(.document.body.innerhtml, "pnlResult") > 0
  24.         DoEvents
  25.     Loop
  26.     Set A = .document.getelementbyid("pnlResult")

  28.     Do Until InStr(result, "Remarks:") > 0
  29.     DoEvents
  30.     result = A.innerhtml
  31.     Loop

  33. Debug.Print Cells(i, 1)

  35. Next i

  37. End With

  39. End Sub
複製代碼
最初運行是沒有問題，但當我的LOOPING行了十多次後，我就會遇到ERROR，說我「沒有使用權限」，然後程式便在「Set A = .document.getelementbyid("pnlResult")」停止。如果我在此時按F8，程式是可以繼續運行。
於是我在想是不是因為我的上一句：「.document.getelementbyid("btnSearch").Click」，網頁redirect到結果網頁，需要時間產生html code，導致我行 set A那一句時，網頁還沒有pnlResult的item。於是我便加上了：
  1.     Do Until InStr(.document.body.innerhtml, "pnlResult") > 0
  2.         DoEvents
  3.     Loop
複製代碼
先檢查html code中有沒有「pnlResult」才set A，可是問題仍然存在，我仍然需要人手重啟程式。請問各位有沒有方法解決？謝謝大家。
作者: stillfish00    時間: 2016-12-8 13:45

回復 1# 小俠客
  1. Sub test()
  2.     On Error GoTo ErrorHandle
  3.     Dim http As Object, i As Integer
  4.    
  5.     Set http = CreateObject("InternetExplorer.Application")
  6.     With http
  7.         For i = 1 To 100
  8.             .Navigate "http://www.hkexnews.hk/sdw/search/search_sdw.asp"
  9.             .Visible = True
  10.             Do While .readyState <> 4: DoEvents: Loop
  11.             
  12.             .document.getelementbyid("ddlShareholdingDay").Value = 30
  13.             .document.getelementbyid("ddlShareholdingMonth").Value = 11
  14.             .document.getelementbyid("ddlShareholdingYear").Value = 2016
  15.             .document.getelementbyid("txtStockCode").Value = Format(Cells(i, 1), "00000")
  16.             .document.getelementbyid("btnSearch").Click
  17.             Do Until InStr(.document.body.innerhtml, "pnlResult") > 0
  18.                 DoEvents
  19.             Loop
  20.             Set A = .document.getelementbyid("pnlResult")
  21.             Do Until InStr(result, "Remarks:") > 0
  22.                 DoEvents
  23.                 result = A.innerhtml
  24.             Loop
  25.             
  26.             Debug.Print Cells(i, 1)
  27.         Next i
  28.     End With
  29.    
  30. Exit Sub
  31. ErrorHandle:
  32.     If Err.Number = 70 Then '沒有使用權限
  33.         Resume  'do nothing, back to error
  34.     Else
  35.         Debug.Print Err.Number, Err.Source, Err.Description
  36.         Stop    'F8 to debug problem
  37.         Resume
  38.     End If
  39. End Sub
複製代碼
作者: 小俠客    時間: 2016-12-13 10:50

本帖最後由 小俠客 於 2016-12-13 10:56 編輯
回復  小俠客
stillfish00 發表於 2016-12-8 13:45



    沒想到原來可以用ERROR HANDLING的方法，謝謝大大。但我使用error handle時因為下面的小問題而出錯，所以我只能用sleep的方法，沒有用error handle
一個小問題，如果程式尋找沒有資料的編號，例如：「820」，網頁會有pop-up msgbox說：「Stock code 820 does not exist ... 」，所以我想先檢查html有沒有「does not exist 」的字眼，如果有我便跳到下一隻。
但可能因為pop-up msgbox的關係，我下一個loop走到「.Navigate "http://www.hkexnews.hk/sdw/search/search_sdw.asp"」時會顯示「-2147024726   VBAProject    'Navigate' 方法 ('IWebBrowser2' 物件) 失敗」
  1. Sub test()
  2. Dim http As Object, i As Integer

  4. Set http = CreateObject("InternetExplorer.Application")

  6. With http

  8. For i = 1 To 100

  10.     .Navigate "http://www.hkexnews.hk/sdw/search/search_sdw.asp"
  11.     .Visible = True
  12.     Do While .readyState <> 4
  13.         DoEvents
  14.     Loop
  15.    
  16.     .document.getelementbyid("ddlShareholdingDay").Value = 30
  17.     .document.getelementbyid("ddlShareholdingMonth").Value = 11
  18.     .document.getelementbyid("ddlShareholdingYear").Value = 2016
  19.     .document.getelementbyid("txtStockCode").Value = Format(Cells(i, 1), "00000")
  20.     .document.getelementbyid("btnSearch").Click

  22.    sleep 2000

  24.                 result = http.document.body.innerhtml
  25.                
  26.                 If InStr(result, "Network Error") > 0 Then
  27.                     MsgBox "Website error"
  28.                     GoTo out
  29.                 End If
  30.                
  31.                 If InStr(result, "does not exist OR not available for enquiry") > 0 Then
  32.                     GoTo nextd
  33.                 End If
  34.    
  35.     Do Until InStr(result , "pnlResult") > 0
  36.         DoEvents
  37.     Loop
  38.     Set A = .document.getelementbyid("pnlResult")
  39.    result = A.innerhtml

  41.     Do Until InStr(result, "Remarks:") > 0
  42.     DoEvents
  43.     result = A.innerhtml
  44.     Loop

  46. Debug.Print Cells(i, 1)

  48. Next i

  50. End With

  52. End Sub
複製代碼
請問有沒有方法關掉IE的pop-up msgbox？謝謝
作者: GBKEE    時間: 2016-12-14 10:50

回復 3# 小俠客

試試看 2003, XP, IE8 下:沒有權限的問題
  1. Option Explicit
  2. Sub EX_IE按下Enter()
  3.     Dim http As Object, i As Integer, A As Object, Result As String
  4.     Set http = CreateObject("InternetExplorer.Application")
  5.     With http
  6.         .Navigate "http://www.hkexnews.hk/sdw/search/search_sdw.asp"
  7.         '.Visible = True
  8.         For i = 1 To 100
  9.             Do While .readyState <> 4 Or .Busy:         DoEvents:    Loop
  10.             .document.getelementbyid("ddlShareholdingDay").Value = 30
  11.             .document.getelementbyid("ddlShareholdingMonth").Value = 11
  12.             .document.getelementbyid("ddlShareholdingYear").Value = 2016
  13.             .document.getelementbyid("txtStockCode").Value = Format(Cells(i, 1), "00000")
  14.             .document.getelementbyid("btnSearch").Click
  15.             Do While .readyState <> 4 Or .Busy:
  16.                 DoEvents
  17.                 If .Busy Then
  18.                     .document.Focus
  19.                     DoEvents
  20.                     Application.SendKeys "{ENTER}", True   '**按下鍵
  21.                 End If
  22.             Loop
  23.             Result = ""
  24.             Do Until InStr(Result, "pnlResult") > 0
  25.                 Result = .document.body.innerhtml
  26.                 If Len(Result) > 0 Then
  27.                     Cells(i, 2) = IIf(InStr(Result, "pnlResult") > 0, "OK", "Not Exist")
  28.                     If InStr(Result, "pnlResult") = 0 Then GoTo Next_StockCode
  29.                 End If
  30.             Loop
  31.             Set A = .document.getelementbyid("pnlResult")
  32.             Do Until InStr(Result, "Remarks:") > 0
  33.                 DoEvents
  34.                 Result = A.innerhtml
  35.             Loop
  36. Next_StockCode:
  37.         Next i
  38.         .Quit
  39.     End With
  40.     MsgBox "OK"
  41. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)