本帖最後由 smart3135 於 2017-11-11 10:08 編輯
想請教一下各位前輩，因為我公司有些工作是需要重複執行
把EXCEL內容寫到記事本裡，這兩天做了很多功課
大致上前半段程式碼已經寫的差不多了
剩下就是後半段寫入記事本(還沒開始著手)
但是現在遇到一個難題，就是前半段的程式碼
在抓取不到相對應的網頁時會出現錯誤視窗
我知道可以用on error resume next來忽略錯誤
但卻會卡在接下來的Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
形成無限迴圈，而如果使用另一種on error goto XX
在我自己設定的迴圈中，第一次是可以跳到想要的程序位置
但執行第二次就會出錯，不知道為什麼，實是在找不到方法了，所以才來請教各位前輩
最理想的情況就是抓不到網頁時連錯誤視窗都不要跳出
直接跳到我設定迴圈的NEXT，麻煩各位前輩指點一下，謝謝。
不知道為什麼壓縮檔的檔案丟不上來
只能放上程式碼
- Option Explicit
- Sub Ex1()
- On Error GoTo AR
- Dim A, B, C, D, E, F, G, H, I, J, K As String, R, rng As Range
- Dim URL, URL1, URL2, URL3, URL4, URL5, URL6, URL7, URL8, URL9, URL10 As String
- J = InputBox("請輸入網頁號碼")
- H = InputBox("請輸入工單號碼")
- With Sheets(2)
- Set rng = .Range("A1", .Range("A65535").End(xlUp))
- End With
- 'URL1 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Feeder SetupRepIndex_T.html"
- 'URL2 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Part PlacementRepIndex_T.html"
- 'URL3 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Feeder SetupRepIndex_T.html"
- 'URL4 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Part PlacementRepIndex_T.html"
- 'URL5 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Feeder SetupRepIndex_B.html"
- 'URL6 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\NXTL_Part PlacementRepIndex_B.html"
- 'URL7 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Feeder SetupRepIndex_B.html"
- 'URL8 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPF_Part PlacementRepIndex_B.html"
- 'URL9 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPFB_Feeder SetupRepIndex_B.html"
- 'URL10 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & "\XPFB_Part PlacementRepIndex_B.html"
-
- With CreateObject("InternetExplorer.Application")
- For Each URL In rng
- URL1 = "C:\FujiFlexa\Client\Report\Jobdata\job00" & J & URL
- .Visible = False
- ' On Error Resume Next
- On Error GoTo AR
-
- ' On Error Resume Next '找不到網頁還無法解決
- ' On Error GoTo 0
- .Navigate URL1
-
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- .execwb 17, 2 '選取 網頁內容
- .execwb 12, 2 '複製 網頁內容
-
- Sheets(1).Activate
- With ActiveSheet '指定工作表
- .Cells.Clear '清理 工作表
- .[a1].Select
- .PasteSpecial Format:="Unicode 文字", Link:=False, DisplayAsIcon:= _
- False, NoHTMLFormatting:=True
-
- .[a1].Select
- End With
- .Quit
-
-
- If InStr([A2], "Feeder") Then
- A = "_" + Mid([A7], 9, 3) + "A" + Right([A9], 2) 'NXTA_T
- ' MsgBox A
- B = Left([A9], Len([A9]) - 2) '去掉尾巴的_T
-
- If InStr(Mid(B, 13, 3), "_") Then
- C = Mid(B, 13, 3) '如果有_就是LA或LB
- Else
- C = Mid(B, 13, 4) '如果沒有就是LAB或LBB
- End If
- If InStr(Mid([A9], 23, 1), "_") Then
- D = Right(B, Len(B) - 22) '抓程式版本
- Else
- D = Right(B, Len(B) - 21) '抓程式版本
- End If
- I = "_" + Mid([A11], 10, 6)
- Else
- A = "_" + Mid([A7], 9, 3) + "A" + Right([A8], 2) + "S" 'NXTA_TS
- ' MsgBox A
- B = Left([A8], Len([A8]) - 2) '去掉尾巴的_T
- If InStr(Mid(B, 13, 3), "_") Then
- C = Mid(B, 13, 3) '如果有_就是LA或LB
- Else
- C = Mid(B, 13, 4) '如果沒有就是LAB或LBB
- End If
- If InStr(Mid([A8], 23, 1), "_") Then
- D = Right(B, Len(B) - 22) '抓程式版本
- Else
- D = Right(B, Len(B) - 21) '抓程式版本
- End If
- I = "_" + Mid([A10], 10, 6)
- End If
- ' MsgBox B
- ' MsgBox C
- ' MsgBox D
-
-
- E = C + H + D + I + A
- MsgBox E
- AR:
- Next
- End With
-
- End Sub
|
發表於 2017-11-11 10:06
| 
發表於 2017-11-11 14:54
| 
