返回列表 上一主題 發帖

[發問] on error resume next卡在無限迴圈

[發問] on error resume next卡在無限迴圈

本帖最後由 smart3135 於 2017-11-11 10:08 編輯

想請教一下各位前輩,因為我公司有些工作是需要重複執行

把EXCEL內容寫到記事本裡,這兩天做了很多功課

大致上前半段程式碼已經寫的差不多了

剩下就是後半段寫入記事本(還沒開始著手)

但是現在遇到一個難題,就是前半段的程式碼

在抓取不到相對應的網頁時會出現錯誤視窗

我知道可以用on error resume next來忽略錯誤

但卻會卡在接下來的Do While .Busy Or .ReadyState <> 4: DoEvents: Loop

形成無限迴圈,而如果使用另一種on error goto XX

在我自己設定的迴圈中,第一次是可以跳到想要的程序位置

但執行第二次就會出錯,不知道為什麼,實是在找不到方法了,所以才來請教各位前輩

最理想的情況就是抓不到網頁時連錯誤視窗都不要跳出

直接跳到我設定迴圈的NEXT,麻煩各位前輩指點一下,謝謝。
不知道為什麼壓縮檔的檔案丟不上來
只能放上程式碼
55555555.jpg
2017-11-11 09:58
6666666666.jpg
2017-11-11 09:58
  1. Option Explicit

  2. Sub Ex1()

  3. On Error GoTo AR

  4. Dim A, B, C, D, E, F, G, H, I, J, K As String, R, rng As Range

  5. Dim URL, URL1, URL2, URL3, URL4, URL5, URL6, URL7, URL8, URL9, URL10 As String

  6. J = InputBox("請輸入網頁號碼")

  7. H = InputBox("請輸入工單號碼")

  8. With Sheets(2)

  9. Set rng = .Range("A1", .Range("A65535").End(xlUp))

  10. End With

  11. 'URL1 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Feeder SetupRepIndex_T.html"

  12. 'URL2 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Part PlacementRepIndex_T.html"

  13. 'URL3 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Feeder SetupRepIndex_T.html"

  14. 'URL4 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Part PlacementRepIndex_T.html"

  15. 'URL5 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Feeder SetupRepIndex_B.html"

  16. 'URL6 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Part PlacementRepIndex_B.html"

  17. 'URL7 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Feeder SetupRepIndex_B.html"

  18. 'URL8 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Part PlacementRepIndex_B.html"

  19. 'URL9 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPFB_Feeder SetupRepIndex_B.html"

  20. 'URL10 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPFB_Part PlacementRepIndex_B.html"



  21. With CreateObject("InternetExplorer.Application")

  22. For Each URL In rng

  23. URL1 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & URL

  24. .Visible = False

  25. ' On Error Resume Next

  26. On Error GoTo AR



  27. ' On Error Resume Next '找不到網頁還無法解決

  28. ' On Error GoTo 0

  29. .Navigate URL1



  30. Do While .Busy Or .ReadyState <> 4: DoEvents: Loop

  31. .execwb 17, 2 '選取 網頁內容

  32. .execwb 12, 2 '複製 網頁內容



  33. Sheets(1).Activate

  34. With ActiveSheet '指定工作表

  35. .Cells.Clear '清理 工作表

  36. .[a1].Select

  37. .PasteSpecial Format:="Unicode 文字", Link:=False, DisplayAsIcon:= _

  38. False, NoHTMLFormatting:=True



  39. .[a1].Select

  40. End With

  41. .Quit





  42. If InStr([A2], "Feeder") Then

  43. A = "_" + Mid([A7], 9, 3) + "A" + Right([A9], 2) 'NXTA_T

  44. ' MsgBox A

  45. B = Left([A9], Len([A9]) - 2) '去掉尾巴的_T



  46. If InStr(Mid(B, 13, 3), "_") Then

  47. C = Mid(B, 13, 3) '如果有_就是LA或LB

  48. Else

  49. C = Mid(B, 13, 4) '如果沒有就是LAB或LBB

  50. End If

  51. If InStr(Mid([A9], 23, 1), "_") Then

  52. D = Right(B, Len(B) - 22) '抓程式版本

  53. Else

  54. D = Right(B, Len(B) - 21) '抓程式版本

  55. End If

  56. I = "_" + Mid([A11], 10, 6)

  57. Else

  58. A = "_" + Mid([A7], 9, 3) + "A" + Right([A8], 2) + "S" 'NXTA_TS

  59. ' MsgBox A

  60. B = Left([A8], Len([A8]) - 2) '去掉尾巴的_T

  61. If InStr(Mid(B, 13, 3), "_") Then

  62. C = Mid(B, 13, 3) '如果有_就是LA或LB

  63. Else

  64. C = Mid(B, 13, 4) '如果沒有就是LAB或LBB

  65. End If

  66. If InStr(Mid([A8], 23, 1), "_") Then

  67. D = Right(B, Len(B) - 22) '抓程式版本

  68. Else

  69. D = Right(B, Len(B) - 21) '抓程式版本

  70. End If

  71. I = "_" + Mid([A10], 10, 6)

  72. End If

  73. ' MsgBox B

  74. ' MsgBox C

  75. ' MsgBox D





  76. E = C + H + D + I + A

  77. MsgBox E

  78. AR:

  79. Next

  80. End With



  81. End Sub
複製代碼
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

回復 1# smart3135
上傳附檔 用擴展名: chm, pdf, zip, rar, tar, gz, bzip2, gif, jpg, jpeg, png
  1. Option Explicit
  2. Sub Ex1()
  3.     Dim IE As Object
  4.     Dim Rng As Range, UrL As String, R As Range, j
  5.     Set IE = CreateObject("InternetExplorer.Application")
  6.     With Sheets(2)
  7.         Set Rng = .Range("A1", .Range("A65535").End(xlUp))
  8.     End With
  9.     For Each R In Rng
  10.         UrL = "C:\FujiFlexa\Client\Report\Jobdata\job00" & j & R
  11.         If Dir(UrL) = "" Then '檢查不到檔案
  12.             If MsgBox("找不到 " & UrL & vbLf & "是(Y):繼續下一個網頁" & vbLf & "否(N):結束程式", vbYesNo) = vbYes Then
  13.                 GoTo AG1
  14.             Else
  15.                 IE.Quit
  16.                 Exit Sub
  17.             End If
  18.         End If
  19.         With IE
  20.             .Navigate UrL
  21.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  22.             '**************
  23.             '程式碼********
  24.             '**************
  25.         End With
  26. AG1:
  27.     Next
  28.     IE.Quit
  29. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復  smart3135
上傳附檔 用擴展名: chm, pdf, zip, rar, tar, gz, bzip2, gif, jpg, jpeg, png
GBKEE 發表於 2017-11-11 14:54

不好意思,不知為什麼用手機無法上傳,回到家中用電腦才可以
目前人已離開公司,無法試G大提供的程式碼,大概了解它的邏輯
要等下星期到公司才能再試看看了,先感謝您
test.zip (23.17 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 是非當教育,讚美作警惕。
返回列表 上一主題