彰化一整天的論壇

 找回密碼
 立即註冊
搜索
查看: 283|回復: 0

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

[複製鏈接]
發表於 2017-1-10 09:47:39 | 顯示全部樓層 |閱讀模式
本帖最後由 discuz 於 2017-1-12 09:19 編輯
  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. Sub getALLBrowsersaaa()
  4. On Error GoTo Err_Clear
  5.     Dim mainWorkBook As Workbook
  6.    

  7.    
  8.     Set objShell = CreateObject("Shell.Application")
  9.     Set objAllWindows = objShell.Windows
  10.     Set mainWorkBook = ActiveWorkbook

  11. For Each ow In objAllWindows
  12.     If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
  13.         If (InStr(1, ow.LocationURL, "https://login.104.com.tw/login.cfm", vbTextCompare)) Then
  14.                

  15.     Set HTMLDoc = ow.document
  16.      HTMLDoc.all.id_name.Value = "aaa"    '< -帳號隨便打讓他跳警告
  17. For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
  18.     If MyHTML_Element.Type = "submit" And MyHTML_Element.Value = "會員登入" Then
  19.      
  20.      
  21. '     Call 雙開vba  <先不用,想傳去給Sub StartAsub()  SetTimer Application.hWnd, 1, 15000, AddressOf getALLBrowsersaaa>
  22.      MyHTML_Element.Click   <--進入ie就卡了
  23. Do While ow.readyState <> 4 Or ow.Busy:
  24.                 DoEvents
  25.                 If ow.Busy Then
  26.                 ow.Visible = False     ''就是從新隱藏使用視窗
  27.                 ow.Visible = True      ''接著又重新顯示active使用視窗
  28.                     ow.document.Focus
  29.                     DoEvents

  30.                     Application.SendKeys "{ENTER}", True   '**按下鍵
  31.                 End If
  32.             Loop
  33. : Exit For
  34.      End If
  35.     Next



  36.     End If
  37. End If
  38.         
  39.     Next
  40. Err_Clear:
  41. If Err <> 0 Then
  42. Err.Clear
  43.     Resume Next
  44. End If

  45. '    Call StopAsub  <先不用,想傳回去StopAsub()   killtimer>
  46. End Sub
複製代碼
  1. set wshshell = createobject("wscript.shell")

  2. do
  3.     ret = wshshell.AppActivate("網頁訊息")
  4. loop until ret = true

  5.     wscript.sleep 1000
  6.     ret = wshshell.appactivate("網頁訊息")
  7.         if ret = true then
  8.                    ret = wshshell.appactivate("網頁訊息")
  9.                 wscript.sleep 1000
  10.                 wshshell.sendkeys "{enter}"
  11.         end if
  12.         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. Do
  3.     ret = WshShell.AppActivate("選擇要上傳的檔案")
  4. Loop Until ret = True

  5. wscript.sleep 500
  6. ret = WshShell.AppActivate("選擇要上傳的檔案")
  7. If ret = True Then
  8.     ret = WshShell.AppActivate("選擇要上傳的檔案")
  9.     wscript.sleep 500
  10.     WshShell.SendKeys "%n"
  11.     WshShell.SendKeys "+"
  12.     WshShell.SendKeys "C:\USERS\USER\DESKTOP\AA.JPG"
  13.     WshShell.SendKeys "%o"
  14. End If
  15. wscript.sleep 1000
複製代碼

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

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-1-19 11:17 , Processed in 0.032223 second(s), 12 queries , Apc On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表