Помогите довести до ума

[theal]

Вот код програмки которая открывает страницу сайта ,стягивает все ссылки в листбокс.Помогите пожалуйста,что ссылки не стягивать в листбокс а найти их в браузере и произвести програмно переход по ним.С листбокса при переходе не определяется ,откуда сделан переход..А нужно что бы было видно что переход совершается с сайта с которого и взяты эти ссылки.

Код: Выделить всё


Dim Adres As String
Dim partner As String
Dim ie As Object

   
   

Private Sub Command1_Click()

    Adres = Text1.Text
    WebBrowser1.Navigate Adres
End Sub

Private Sub Command2_Click()
WebBrowser1.Refresh 'Â Caption ýòîé êíîïêè íàïèøèòå "Îáíîâèòü"
End Sub

Private Sub Command3_Click()
Close
End
End Sub


Private Sub Command6_Click()
Set ie = CreateObject("InternetExplorer.Application")
End Sub

Private Sub Command7_Click()
partner = Text2.Text
WebBrowser2.Navigate partner
End Sub

Private Sub List1_Click()
Text2.Text = List1.Text
End Sub

Private Sub Text2_Change()
Timer2.Enabled = True
End Sub

Private Sub Text3_Change()
If Text3.Text = "30" Then
partner = Text2.Text
WebBrowser2.Navigate partner
Text3.Text = "0"
Timer2.Enabled = False
End If
End Sub

Private Sub Timer1_Timer()
If Text2.Text = "" Then
Timer1.Enabled = False
End If
Text3.Text = Text3.Text + 1
End Sub

Private Sub Timer2_Timer()
Text3 = Text3 + 1
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Label1.Caption = "Çàãðóçêà ïðîèçâåäåíà"
End Sub

Private Sub WebBrowser1_DownloadComplete()
Me.Caption = WebBrowser1.LocationName
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Function Delay(Pause As Single)
Dim Start As Single
Start = Timer
Do While Timer < Start + Pause
DoEvents
Loop
End Function

Private Sub Command4_Click()
On Error Resume Next
List1.Clear
Dim x
WebBrowser1.Navigate Text1.Text
Delay 5 'çàäåðæà íåîáõîäèìà äëÿ çàãðóçêè ñòðàíèöû
'èíîãäà òðåáóåòñÿ óâåëè÷èòü âðåìÿ çàãðóçêè äî 30 ñåêóíä.
For i = 1 To WebBrowser1.Document.links.length - 1
List1.AddItem WebBrowser1.Document.links(i).href

Next
End Sub

Private Sub Command5_Click()
On Error Resume Next
List1.Clear
Dim x
WebBrowser1.Navigate Text1.Text
Delay 5
For i = 0 To 50
masS(i) = ie.Document.Forms(0).elements(i).Value
Next
If InStr(1, WebBrowser1.Document.links(i).href, ".asp") <> 0 Or InStr(1, WebBrowser1.Document.links(i).href, ".htm") <> 0 Then
List1.AddItem WebBrowser1.Document.links(i).href

End If
Next
End Sub

[trash]

Нужно запоминать не только ссылки, но и links(i).sourceIndex, тогда желаемый результат получится с помощью document.all(srcInd).click.
Ну или индекс в links и document.links(i).click, если оно тебе больше нравится.