Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    Dim x As Long
    List1.Clear
    If Not WebBrowser1.Busy Then
        DoEvents
    End If
    MsgBox WebBrowser1.Document.Links.length
    For x = 0 To WebBrowser1.Document.Links.length - 1
        List1.AddItem WebBrowser1.Document.Links.Item(x)
        If InStr(UCase(WebBrowser1.Document.Links.Item(x)), "TIANCAO.NET") > 0 Then
            WebBrowser1.Document.Links.Item(x).Click
        End If
    Next x
End Sub