|
本帖最後由 discuz 於 2017-1-12 09:19 編輯
- 'Private Declare Function SetFocus Lib "user32" Alias "SetFocus2" (ByVal hwnd As Long) As Long
- 'Private Declare PtrSafe Function WinAPISetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As LongPtr) As Long
- Sub getALLBrowsersaaa()
- On Error GoTo Err_Clear
- Dim mainWorkBook As Workbook
-
-
- Set objShell = CreateObject("Shell.Application")
- Set objAllWindows = objShell.Windows
- Set mainWorkBook = ActiveWorkbook
- For Each ow In objAllWindows
- If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
- If (InStr(1, ow.LocationURL, "https://login.104.com.tw/login.cfm", vbTextCompare)) Then
-
- Set HTMLDoc = ow.document
- HTMLDoc.all.id_name.Value = "aaa" '< -帳號隨便打讓他跳警告
- For Each MyHTML_Element In HTMLDoc.getElementsByTagName("input")
- If MyHTML_Element.Type = "submit" And MyHTML_Element.Value = "會員登入" Then
-
-
- ' Call 雙開vba <先不用,想傳去給Sub StartAsub() SetTimer Application.hWnd, 1, 15000, AddressOf getALLBrowsersaaa>
- MyHTML_Element.Click <--進入ie就卡了
- Do While ow.readyState <> 4 Or ow.Busy:
- DoEvents
- If ow.Busy Then
- ow.Visible = False ''就是從新隱藏使用視窗
- ow.Visible = True ''接著又重新顯示active使用視窗
- ow.document.Focus
- DoEvents
- Application.SendKeys "{ENTER}", True '**按下鍵
- End If
- Loop
- : Exit For
- End If
- Next
- End If
- End If
-
- Next
- Err_Clear:
- If Err <> 0 Then
- Err.Clear
- Resume Next
- End If
- ' Call StopAsub <先不用,想傳回去StopAsub() killtimer>
- End Sub
複製代碼- set wshshell = createobject("wscript.shell")
- do
- ret = wshshell.AppActivate("網頁訊息")
- loop until ret = true
- wscript.sleep 1000
- ret = wshshell.appactivate("網頁訊息")
- if ret = true then
- ret = wshshell.appactivate("網頁訊息")
- wscript.sleep 1000
- wshshell.sendkeys "{enter}"
- end if
- wscript.sleep 1000
複製代碼- Sub test()
- Dim x
- Dim oie As Object: Set oie = CreateObject("internetexplorer.application")
- With oie
- .Visible = True
- .Navigate "https://login.104.com.tw/login.cfm"
- Do While .readystate <> 4 Or .busy: DoEvents: Loop
- .Document.getelementByid("id_name").Value = "aaa"
- For Each x In .Document.getElementsByTagName("input")
- If x.Type = "submit" And x.Value = "會員登入" Then
- With .Document.parentWindow
- .execScript "window.nativeAlert = window.alert" '儲存原始的alert
- .execScript "window.alert = function() {}" '覆寫alert function
- x.Click
- .execScript "window.alert = window.nativeAlert" '還原原始的alert
- End With
- Exit For
- End If
- Next
- Do While .readystate <> 4 Or .busy: DoEvents: Loop
- .Quit
- End With
- End Sub
複製代碼- Set WshShell = CreateObject("wscript.shell")
- Do
- ret = WshShell.AppActivate("選擇要上傳的檔案")
- Loop Until ret = True
- wscript.sleep 500
- ret = WshShell.AppActivate("選擇要上傳的檔案")
- If ret = True Then
- ret = WshShell.AppActivate("選擇要上傳的檔案")
- wscript.sleep 500
- WshShell.SendKeys "%n"
- WshShell.SendKeys "+"
- WshShell.SendKeys "C:\USERS\USER\DESKTOP\AA.JPG"
- WshShell.SendKeys "%o"
- End If
- wscript.sleep 1000
複製代碼
文章來源: http://forum.twbts.com/viewthread.php?tid=19128
|
|