vba控制網頁 browser碰上alert停住了

discuz

1. 'Private Declare Function SetFocus Lib "user32" Alias "SetFocus2" (ByVal hwnd As Long) As Long
   
2. 'Private Declare PtrSafe Function WinAPISetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As LongPtr) As Long
   
3. 
   
4. Sub getALLBrowsersaaa()
   
5. On Error GoTo Err_Clear
   
6.     Dim mainWorkBook As Workbook
   
7.    
   
8. 
   
9.    
   
10.     Set objShell = CreateObject("Shell.Application")
    
11.     Set objAllWindows = objShell.Windows
    
12.     Set mainWorkBook = ActiveWorkbook
    
13. 
    
14. For Each ow In objAllWindows
    
15.     If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
    
16.         If (InStr(1, ow.LocationURL, "https://login.104.com.tw/login.cfm", vbTextCompare)) Then
    
17.                
    
18. 
    
19.     Set HTMLDoc = ow.document
    
20.      HTMLDoc.all.id_name.Value = "aaa"    '< -帳號隨便打讓他跳警告
    
21. For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
    
22.     If MyHTML_Element.Type = "submit" And MyHTML_Element.Value = "會員登入" Then
    
23.      
    
24.      
    
25. '     Call 雙開vba  <先不用,想傳去給Sub StartAsub()  SetTimer Application.hWnd, 1, 15000, AddressOf getALLBrowsersaaa>
    
26.      MyHTML_Element.Click   <--進入ie就卡了
    
27. Do While ow.readyState <> 4 Or ow.Busy:
    
28.                 DoEvents
    
29.                 If ow.Busy Then
    
30.                 ow.Visible = False     ''就是從新隱藏使用視窗
    
31.                 ow.Visible = True      ''接著又重新顯示active使用視窗
    
32.                     ow.document.Focus
    
33.                     DoEvents
    
34. 
    
35.                     Application.SendKeys "{ENTER}", True   '**按下鍵
    
36.                 End If
    
37.             Loop
    
38. : Exit For
    
39.      End If
    
40.     Next
    
41. 
    
42. 
    
43. 
    
44.     End If
    
45. End If
    
46.         
    
47.     Next
    
48. Err_Clear:
    
49. If Err <> 0 Then
    
50. Err.Clear
    
51.     Resume Next
    
52. End If
    
53. 
    
54. '    Call StopAsub  <先不用,想傳回去StopAsub()   killtimer>
    
55. End Sub

複製代碼

1. set wshshell = createobject("wscript.shell")
   
2. 
   
3. do
   
4.     ret = wshshell.AppActivate("網頁訊息")
   
5. loop until ret = true
   
6. 
   
7.     wscript.sleep 1000
   
8.     ret = wshshell.appactivate("網頁訊息")
   
9.         if ret = true then
   
10.                    ret = wshshell.appactivate("網頁訊息")
    
11.                 wscript.sleep 1000
    
12.                 wshshell.sendkeys "{enter}"
    
13.         end if
    
14.         wscript.sleep 1000

複製代碼

1. Sub test()
   
2.     Dim x
   
3.     Dim oie As Object: Set oie = CreateObject("internetexplorer.application")
   
4.     With oie
   
5.         .Visible = True
   
6.         .Navigate "https://login.104.com.tw/login.cfm"
   
7.         Do While .readystate <> 4 Or .busy: DoEvents: Loop
   
8.         .Document.getelementByid("id_name").Value = "aaa"
   
9.         For Each x In .Document.getElementsByTagName("input")
   
10.             If x.Type = "submit" And x.Value = "會員登入" Then
    
11.                 With .Document.parentWindow
    
12.                    .execScript "window.nativeAlert = window.alert"   '儲存原始的alert
    
13.                     .execScript "window.alert = function() {}"    '覆寫alert function
    
14.                     x.Click
    
15.                     .execScript "window.alert = window.nativeAlert"   '還原原始的alert
    
16.                 End With
    
17.                 Exit For
    
18.             End If
    
19.         Next
    
20.         Do While .readystate <> 4 Or .busy: DoEvents: Loop
    
21.         .Quit
    
22.     End With
    
23. End Sub

複製代碼

1. Set WshShell = CreateObject("wscript.shell")
   
2. 
   
3. Do
   
4.     ret = WshShell.AppActivate("選擇要上傳的檔案")
   
5. Loop Until ret = True
   
6. 
   
7. wscript.sleep 500
   
8. ret = WshShell.AppActivate("選擇要上傳的檔案")
   
9. If ret = True Then
   
10.     ret = WshShell.AppActivate("選擇要上傳的檔案")
    
11.     wscript.sleep 500
    
12.     WshShell.SendKeys "%n"
    
13.     WshShell.SendKeys "+"
    
14.     WshShell.SendKeys "C:\USERS\USER\DESKTOP\AA.JPG"
    
15.     WshShell.SendKeys "%o"
    
16. End If
    
17. wscript.sleep 1000

複製代碼

文章來源: http://forum.twbts.com/viewthread.php?tid=19128