Siteden bilgi çekmek istiyorum

Katılım
14 Haziran 2006
Mesajlar
129
www.equasis.org sitesinden bilgi çekmek istiyorum
Aşağıdaki kodları Zeki Gürsoy un yardımı ile bu hale geldi fakat bir kaç değişikliğe ihtiyacım var.

Aşağıdaki kodlar ile TOKYO yazınca 10 tane sonuç bulduysa en üsttekini alıyor bu 10 taneyi bize sunsa bizim seçtiğimizi alsa daha süper olacak..Birde o düğme gene kalsın ama C hücresine birşey yazdığımda onu da otomatik alğılayıp arasın istiyorum bu zaten en önemlisi benim için.


Sub test()
On Error Resume Next

sor = InputBox("anahtar kelimeyi yazın", "www.excel.web.tr")
If Len(Trim(sor)) = 0 Then Exit Sub

With CreateObject("InternetExplorer.Application")
.navigate "http://www.equasis.org"
'.Visible = 1
Do Until .ReadyState = 4: Loop
Do While .Busy: Loop

.document.all.j_email.Value = "atillaciftci@gmail.com"
.document.all.j_password.Value = "1234567"
.document.all.submit.Click

Do Until .ReadyState = 4: Loop
Do While .Busy: Loop

.navigate "http://www.equasis.org/EquasisWeb/restricted/ShipSearch?fs=ShipSearch"

Do Until .ReadyState = 4: Loop
Do While .Busy: Loop

.document.all.p_name.Value = sor
.document.all.submit.Click

Do Until .ReadyState = 4: Loop
Do While .Busy: Loop

For Each t In .document.all.tags("table")
If LCase(t.innerhtml) Like "*name of ship*" Then
x = Split(t.Rows(2).Cells(0).innerhtml, "'")(1)
Exit For
End If
Next

.goback

Do Until .ReadyState = 4: Loop
Do While .Busy: Loop

.document.all.p_imo.Value = x
.document.all.submit.Click

Do Until .ReadyState = 4: Loop
Do While .Busy: Loop


Set sh = Sheet2
sat = sh.[b65536].End(3).Row + 1
s = 1

Set t = .document.getElementsByTagName("table").Item(5)
For i = 0 To t.Rows.Length - 1
s = s + 1
For j = 0 To t.Rows(i).Cells.Length - 1
sh.Cells(sat, s) = t.Rows(i).Cells(1).innerText
Next
Next

Set t = .document.getElementsByTagName("table").Item(12)
For i = 2 To t.Rows.Length - 1
s = s + 1
For j = 0 To t.Rows(i).Cells.Length - 1
sh.Cells(sat, s) = t.Rows(i).Cells(2).innerText
Next
Next

Set t = .document.getElementsByTagName("table").Item(16)
s = s + 1
sh.Cells(sat, s) = t.Rows(1).Cells(0).innerText

Set t = .document.getElementsByTagName("table").Item(20)
s = s + 1
sh.Cells(sat, s) = t.Rows(2).Cells(0).innerText

Set t = .document.getElementsByTagName("table").Item(24)
s = s + 1
sh.Cells(sat, s) = t.Rows(2).Cells(0).innerText

Set t = .document.getElementsByTagName("table").Item(28)
s = s + 1
sh.Cells(sat, s) = t.Rows(2).Cells(0).innerText

.Quit
End With

If Err Then MsgBox Err.Description
End Sub
 

Ekli dosyalar

Üst