2012年9月18日 星期二

VB6 控制 IE 填入值及點擊按鈕

參考引用
--
 ' 需引用 iframe.dll 元件
' 需引用 MSHTML.TLB 元件

Dim WithEvents IE As InternetExplorer
Dim Doc As HTMLDocument

Private Sub Command1_Click()
    IENavigate "http://xxxxx"
End Sub

Private Sub Command2_Click()
    IENavigate "http://www."
End Sub

Private Sub Command3_Click()
    ObjSetValue "input", "ctl00$TzuhuHolder$usridTxt", tb_usridTxt.Text
    ObjSetValue "input", "ctl00$TzuhuHolder$nameTxt", tb_nameTxt.Text
    ObjSetValue "select", "ctl00$TzuhuHolder$yearDDL", cb_yearDDL.Text
    ObjSetValue "select", "ctl00$TzuhuHolder$monthDDL", cb_monthDDL.Text
End Sub

' 建立IE及開啟某網頁
Sub IENavigate(URL As String)
    If IE Is Nothing Then Set IE = New InternetExplorer
    IE.Visible = True
    IE.Width = 1024 + 15
    IE.Height = 640
    IE.navigate URL
End Sub

' 在 IE 載入完成時,要做的事情
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim BObj As Object
    Set BObj = Nothing
    Set Doc = IE.document
    If UrlCheck(URL, "reminder.aspx") Then
    Call ButtonCheck("ctl00$TzuhuHolder$mybutton")
   
    ElseIf UrlCheck(URL, "declare.aspx") Then
   
    ElseIf UrlCheck(URL, "process.aspx") Then
   
    ElseIf UrlCheck(URL, "index.aspx") Then
 Call ButtonCheck("ImageButton1")

    End If
End Sub

' 控制改變某物件的值
Sub ObjSetValue(ObjTagName As String, ObjID As String, ObjValue As String)
    Dim I As Long, BObj As Object
    Dim DocIB As Object
    Set BObj = Nothing
    ObjTagName = LCase(ObjTagName)
    Set DocIB = Doc.getElementsByTagName(ObjTagName)
    For I = 0 To DocIB.length - 1
    If LCase(DocIB(I).id) = LCase(ObjID) Or LCase(DocIB(I).Name) = LCase(ObjID) Then
    Set BObj = Doc.getElementById(ObjID)
    Exit For
    End If
    Next
    If Not BObj Is Nothing Then
    Select Case ObjTagName
    Case "input", "select"
    BObj.Value = ObjValue
    End Select
    End If
End Sub

' 控制點擊某按鈕 (Button) ( Click )
Function ButtonCheck(ObjID As String) As Boolean
    ButtonCheck = False
    If Doc Is Nothing Then Exit Function

    Dim I As Long, BObj As Object
    Dim DocIB As Object
    Set BObj = Nothing
    Set DocIB = Doc.getElementsByTagName("input")
    For I = 0 To DocIB.length - 1
    If LCase(DocIB(I).id) = LCase(ObjID) Or LCase(DocIB(I).Name) = LCase(ObjID) Then
    Set BObj = Doc.getElementById(ObjID)
    Exit For
    End If
    Next

    If Not BObj Is Nothing Then
    BObj.disabled = False
    BObj.Click
    End If

End Function

Function UrlCheck(URL As Variant, ObjID As String) As Boolean
    UrlCheck = LCase(Right(URL, Len(ObjID))) = LCase(ObjID)
End Function

沒有留言:

張貼留言