麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Const 用戶名稱 = "msmplay"
Const 用戶密碼 = "修改為你的登入密碼"
Private Sub Ex()
If 登錄查看 = False Then 登錄
End Sub
Private Function 登錄查看() As Boolean
With CreateObject("InternetExplorer.Application")
.Navigate "http://forum.twbts.com/task.php?item=done"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
登錄查看 = InStr(.Document.BODY.innertext, 用戶名稱)
.Quit '關閉網頁
End With
End Function
Private Sub 登錄()
Dim i As Variant, vDoc As Object
With CreateObject("InternetExplorer.Application")
' .Visible = True
.Navigate "http://forum.twbts.com/logging.php?action=login"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set vDoc = .Document.getElementsByTAGName("INPUT")
For i = 0 To vDoc.Length - 1
If vDoc(i).Name = "username" Then vDoc(i).Value = 用戶名稱
If vDoc(i).Name = "password" Then vDoc(i).Value = 用戶密碼: Exit For
Next
Set vDoc = .Document.getElementsByTAGName("input") '.Click
For i = 0 To vDoc.Length - 1
If vDoc(i).Type = "checkbox" Then vDoc(i).Click: Exit For
Next
Set vDoc = .Document.getElementsByTAGName("button") '.Click
For i = 0 To vDoc.Length - 1
If vDoc(i).Name = "loginsubmit" Then vDoc(i).Click: Exit For
Next
i = Time
Do
DoEvents
If Time > i + #12:00:30 AM# Then MsgBox .Document.Title & vbLf & " 登入失敗 !": .Quit: End
Loop Until InStr(.Document.BODY.innertext, 用戶名稱)
.Quit
End With
End Sub

複製代碼

'請先將專案 [設定引用項目]加入 Microsoft Internet Controls
Option Explicit
Dim myIE As New InternetExplorer
Const myURL = "http://forum.twbts.com/my.php?item=threads" '我的帖子分頁
Sub TEST()
'Set myIE = CreateObject("InternetExplorer.Application")
With myIE
.Visible = True
.Navigate "http://forum.twbts.com/index.php" '進入麻辣家族討論區
Do While .Busy Or .readyState <> 4: DoEvents: Loop
.Document.all.mycredits.Click '點選進入我的帖子，但開啟網頁時是自動開啟一個新的分頁，而且畫面不會自動切換到新分頁頁籤(畫面仍停留在原頁面)
Do: DoEvents: Loop Until InStr(.Document.BODY.INNERTEXT, " 我的帖子")
End With
IE_Function
''我的帖子分頁中-- 轉移分頁網址
With myIE
.Navigate "http://forum.twbts.com/thread-20650-1-1.html"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
End With
End Sub
Private Function IE_Function()
Dim shell_windows As New SHDocVw.ShellWindows
Dim IE As SHDocVw.InternetExplorer
Dim objShell As Object
Set myIE = Nothing
Set objShell = CreateObject("shell.application")
If objShell.Windows.Count = 0 Then '防呆 : Ie 沒有開啟
Shell "C:\Program Files\Internet Explorer\IEXPLORE.EXE", 2 ' (2 應用程式視窗會以一個圖示來顯示，並具有駐點)
MsgBox "請等候 ie 開啟完畢": End
End If
For Each IE In shell_windows
With IE
Do While .Busy Or .readyState <> 4: Loop
If .LocationURL = myURL Then
Set myIE = IE
Exit Function
End If
End With
Next
End Function

複製代碼