返回列表 上一主題 發帖

[發問] vba判斷是否已登入網頁

回復 6# msmplay
  1. Option Explicit
  2. Const 用戶名稱 = "msmplay"
  3. Const 用戶密碼 = "修改為你的登入密碼"
  4. Private Sub Ex()
  5.     If 登錄查看 = False Then 登錄
  6. End Sub
  7. Private Function 登錄查看() As Boolean
  8.     With CreateObject("InternetExplorer.Application")
  9.         .Navigate "http://forum.twbts.com/task.php?item=done"
  10.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  11.         登錄查看 = InStr(.Document.BODY.innertext, 用戶名稱)
  12.         .Quit        '關閉網頁
  13.     End With
  14. End Function
  15. Private Sub 登錄()
  16.     Dim i As Variant, vDoc As Object
  17.     With CreateObject("InternetExplorer.Application")
  18.         ' .Visible = True
  19.         .Navigate "http://forum.twbts.com/logging.php?action=login"
  20.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  21.         Set vDoc = .Document.getElementsByTAGName("INPUT")
  22.         For i = 0 To vDoc.Length - 1
  23.             If vDoc(i).Name = "username" Then vDoc(i).Value = 用戶名稱
  24.             If vDoc(i).Name = "password" Then vDoc(i).Value = 用戶密碼: Exit For
  25.         Next
  26.         Set vDoc = .Document.getElementsByTAGName("input") '.Click
  27.         For i = 0 To vDoc.Length - 1
  28.             If vDoc(i).Type = "checkbox" Then vDoc(i).Click: Exit For
  29.         Next
  30.         Set vDoc = .Document.getElementsByTAGName("button") '.Click
  31.         For i = 0 To vDoc.Length - 1
  32.             If vDoc(i).Name = "loginsubmit" Then vDoc(i).Click: Exit For
  33.         Next
  34.         i = Time
  35.         Do
  36.             DoEvents
  37.             If Time > i + #12:00:30 AM# Then MsgBox .Document.Title & vbLf & " 登入失敗 !": .Quit: End
  38.         Loop Until InStr(.Document.BODY.innertext, 用戶名稱)
  39.         .Quit
  40.     End With
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 8# msmplay
  1. '請先將專案 [設定引用項目]加入  Microsoft Internet Controls
  2. Option Explicit
  3. Dim myIE As New InternetExplorer
  4. Const myURL = "http://forum.twbts.com/my.php?item=threads" '我的帖子分頁
  5. Sub TEST()
  6.     'Set myIE = CreateObject("InternetExplorer.Application")
  7.     With myIE
  8.         .Visible = True
  9.         .Navigate "http://forum.twbts.com/index.php" '進入麻辣家族討論區
  10.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  11.         .Document.all.mycredits.Click '點選進入我的帖子,但開啟網頁時是自動開啟一個新的分頁,而且畫面不會自動切換到新分頁頁籤(畫面仍停留在原頁面)
  12.         Do:     DoEvents:         Loop Until InStr(.Document.BODY.INNERTEXT, " 我的帖子")
  13.     End With
  14.     IE_Function
  15.     ''我的帖子分頁中-- 轉移分頁網址
  16.     With myIE
  17.          .Navigate "http://forum.twbts.com/thread-20650-1-1.html"
  18.           Do While .Busy Or .readyState <> 4: DoEvents: Loop
  19.     End With
  20. End Sub
  21. Private Function IE_Function()
  22.     Dim shell_windows As New SHDocVw.ShellWindows
  23.     Dim IE As SHDocVw.InternetExplorer
  24.     Dim objShell As Object
  25.     Set myIE = Nothing
  26.     Set objShell = CreateObject("shell.application")
  27.     If objShell.Windows.Count = 0 Then  '防呆   :  Ie 沒有開啟
  28.         Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE", 2  ' (2  應用程式視窗會以一個圖示來顯示,並具有駐點)
  29.         MsgBox "請等候 ie 開啟完畢": End
  30.     End If
  31.     For Each IE In shell_windows
  32.         With IE
  33.             Do While .Busy Or .readyState <> 4:         Loop
  34.             If .LocationURL = myURL Then
  35.                 Set myIE = IE
  36.                Exit Function
  37.             End If
  38.         End With
  39.     Next
  40. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 修行要繫緣修心,藉事練心,隨處養心。
返回列表 上一主題