equasis.org Sitesinden bilgi çekmek istiyorum

[atillaciftci]

http://www.equasis.org sitesinden bütün gemilerin isimlerini ve bilgilerini çekmek istiyorum.

Kullanıcı Adı : atillaciftci@gmail.com
Şifre : 1234567

Giriş yaptıktan sonra Ship Search kısmına girip tek tek gemi isimlerini yazıp bilgilere ulaşabiliyorum ben bütün listeyi excel e çekip süzme işlemini excel de yapmak istiyorum mümkünmüdür.

 

[Zeki Gürsoy]

Merhaba,

İstediğiniz mümkün. Ship Search kısmı için de örnek verebilir misiniz?

 

[atillaciftci]

Mesela MTM Tokyo yazın MTM Tokyo isimli Gemi ile ilgili bilgilere ulaşın..

 

[Zeki Gürsoy]

Kodu boş module yapıştırıp "F5" ile çalıştırıp test edin.

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"
        
        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 t.innerhtml Like "*Name of ship*" Then
            
                For i = 0 To t.Rows.Length - 1
                    For j = 0 To t.Rows(i).Cells.Length - 1
                        Cells(i + 1, j + 1) = t.Rows(i).Cells(j).innerText
                    Next
                Next
                
                Exit For
                
            End If
            
        Next
        
        .Quit
        
    End With
    
    If Err Then MsgBox Err.Description
End Sub

 

[atillaciftci]

Zannedersem size tam ne yapmak istediğimi aktaramadım istediğim bu değil aslında. Eke örnek bir excel dosyası koydum oraya bakarsanız zannedersem bu sefer anlaşıcaz..

Kodu boş module yapıştırıp "F5" ile çalıştırıp test edin.

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"
        
        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 t.innerhtml Like "*Name of ship*" Then
            
                For i = 0 To t.Rows.Length - 1
                    For j = 0 To t.Rows(i).Cells.Length - 1
                        Cells(i + 1, j + 1) = t.Rows(i).Cells(j).innerText
                    Next
                Next
                
                Exit For
                
            End If
            
        Next
        
        .Quit
        
    End With
    
    If Err Then MsgBox Err.Description
End Sub

 

[Zeki Gürsoy]

Anlaştık galiba... Kodu ve dosyayı inceleyin.

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

 

[atillaciftci]

Harikasınız......

Süper olmuş harikasınız....
Sizden bir şey daha rica etsem sizin yaptığınızda 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.

Anlaştık galiba... Kodu ve dosyayı inceleyin.

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

 

[atillaciftci]

Zeki bey lütfen yarıda bırakmayın bunlar son isteklerim söz

 

[atillaciftci]

Lütfen ustalar yardım edin..