香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 27th Nov 2005, 22:52 PM | Network / Media | (3001 Reads)

代碼登陸網站 2

有些網站不僅要 UserName 及 Password ,還有特別要求。以下代碼嘗試登陸 OFFICE精英俱部。代碼是 crdotlin 編寫,我修改小小。(有驗證不適用, eg ExcelHome )

Option Explicit
Dim myIE As InternetExplorer
Dim myIEdoc As HTMLDocument
Dim theForm As HTMLFormElement

 
Sub OpenWebpageAndLogin(URL As String, myPW As String, myID As String, _
    Optional myAns As StringOptional selItem As Integer)
Dim theItm As HTMLFormElement
Dim i As Integer
Dim Testing As Variant
Dim flg As Boolean
Set myIE = New InternetExplorer
With myIE
    .Navigate URL
    .Visible = True
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
End With
Set myIEdoc = myIE.Document
Set theForm = findFm(myIEdoc, "password")
With theForm
    For i = 0 To .Length - 1
    Testing = .Item(i).Name
        Select Case .Item(i).Name
            Case "password"
                .Item(i).Value = myPW
                flg = True
            Case "username"
                .Item(i).Value = myID
            Case "answer"
                .Item(i).Value = myAns
            Case "questionid"
                .Item(i).Value = selItem    'the quation's number
            Case Else
        End Select
    Next
End With
If flg Then
    Set theForm = findFm(myIEdoc, "submit")
Else
    myIE.Quit
    MsgBox ("Unexpected Error, I'm quitting.")
End If
Set myIE = Nothing
End Sub

 
 
Function findFm(theDoc As HTMLDocument, theType As StringAs HTMLFormElement
    Dim i As Integer, j As Integer
    Dim theItm As HTMLFormElement
    With theDoc.forms
        For i = 0 To .Length - 1
            Set theItm = .Item(i)
            With theItm
                For j = 0 To .Length - 1
                    If .Item(j).Type = theType Then
                        Set findFm = theItm
                        If theType = "submit" Then .Item(j).Click
                        Exit Function
                    End If
                Next
            End With
        Next
    End With
End Function

 
Sub Test()
   OpenWebpageAndLogin URL:="http://www.officefans.net/cdb/logging.php?action=login", _
    myPW:="xxxxxx", myID:="Emily", myAns:="xxxx", selItem:=7
End Sub
 
 
 ---
直接下載  (另附自動新增引用項目)

[1]

抱歉, 這裡是VBA 為主的


[引用] | 作者 Emily | 17th Jun 2007 13:30 PM | [舉報垃圾留言]