- 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
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
-
36.5 KB Görüntüleme: 9