返回列表 上一主題 發帖

[發問] 在網頁抽取資料時遇到「沒有使用權限」的問題

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
1# 跳轉到 » 正序看帖
打印
tT
發表於 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，可是問題仍然存在，我仍然需要人手重啟程式。請問各位有沒有方法解決？謝謝大家。

test.zip (14.79 KB)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
3#
發表於 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？謝謝

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 知識要用心體會，才能變成自己的智慧。
返回列表 上一主題