Web' de sorgulama buton tıklama sorunu

[tamer42]

Merhabalar,

"https://www.turkiye.gov.tr/imei-sorgulama"linki üzerinden IMEI sorgulatma yapmak istediğimizde,
Aşağıdaki kodda "Sorgula" butonuna tıklatma yapamadım.

yardımcı olabilir misiniz,

ilginize şimden teşekkürler.

Sub xlSorgula()
Dim isbn, Adres As String
Dim element As Object
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim Sht As Worksheet

Set Sht = ActiveSheet

isbn = Sht.Range("A2")

ie.Visible = True

Adres = "https://www.turkiye.gov.tr/imei-sorgulama"
ie.navigate Adres


Do
DoEvents

Loop Until ie.readyState = READYSTATE_COMPLETE
 
 Set doc = ie.document
 
doc.all.txtImei.Value = isbn
 
 Application.Wait (Now + TimeValue("00:00:02"))
 
''doc.forms(0).submit

''GoTo atla

Application.Wait (Now + TimeValue("00:00:01"))

For Each element In doc.getElementsByTagName("Submit")

    If element.Value = "Sorgula" Then
        element.Click
        Application.Wait (Now + TimeValue("00:00:01"))
    End If

Next element

atla:

End Sub

 

[Erdem Akdemir]

Aşağıdaki satırı ekleyin.

doc.getElementsByClassName("submitButton")(0).Click

 

[tamer42]

Aşağıdaki satırı ekleyin.

doc.getElementsByClassName("submitButton")(0).Click

Erdem Hocam ilginize teşekkürler,
yalnız verdiğiniz kodda bir hata verdi.

ben aşağıdaki şekilde çözdüm, benim için şimdi açılan sayfadaki verileri excel ortamına almam gerekiyor.

bu konuda yardımcı olabilir misiniz

For Each inputfield In doc.getElementsByTagName("input")
    If inputfield.Type = "submit" And inputfield.Value = "Sorgula" Then
        inputfield.Click
        Application.Wait (Now + TimeValue("00:00:01"))
        
        Exit For
        
    End If
    
Next

 

[Erdem Akdemir]

Aşağıdaki kodu kullanabilirsiniz.

Sub xlSorgula()
Dim isbn, Adres As String
Dim element As Object
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim Sht As Worksheet

Set Sht = ActiveSheet

FindAndTerminate "IExplore.exe"
 Const MAX_WAIT_SEC As Long = 5

isbn = Sht.Range("A2")
If Len(isbn) <> 15 Then MsgBox ("IMEI 15 karakter olmalı"): Exit Sub

ie.Visible = False

Adres = "https://www.turkiye.gov.tr/imei-sorgulama"
ie.navigate Adres

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop
 
    Set doc = ie.document
 
    doc.all.txtImei.Value = isbn
 
    doc.getElementsByClassName("submitButton")(0).Click

        elapsedTime = Timer
        Do
        If doc.getElementsByClassName("resultContainer").Length > 0 Then Exit Do
        If Timer - elapsedTime > MAX_WAIT_SEC Then
            MsgBox "Bekleme süresini aştı..... kod sonlandırıldı!"
            GoTo SafeExit:
        End If
        Loop

Set deg = doc.getElementsByTagName("dd")

    For Each metin In deg
    
     MsgBox metin.innerText
    Next metin
    
    
SafeExit:
ie.Quit

Set ie = Nothing

End Sub

Sub FindAndTerminate(ByVal strProcName As String)
    Dim objWMIService, objProcess, colProcess
    Dim strComputer, strList
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")
    If colProcess.Count > 0 Then
        For Each objProcess In colProcess
            objProcess.Terminate
        Next objProcess
    End If
End Sub

 

[tamer42]

Aşağıdaki kodu kullanabilirsiniz.

Sub xlSorgula()
Dim isbn, Adres As String
Dim element As Object
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim Sht As Worksheet

Set Sht = ActiveSheet

FindAndTerminate "IExplore.exe"
Const MAX_WAIT_SEC As Long = 5

isbn = Sht.Range("A2")
If Len(isbn) <> 15 Then MsgBox ("IMEI 15 karakter olmalı"): Exit Sub

ie.Visible = False

Adres = "https://www.turkiye.gov.tr/imei-sorgulama"
ie.navigate Adres

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop

    Set doc = ie.document

    doc.all.txtImei.Value = isbn

    doc.getElementsByClassName("submitButton")(0).Click

        elapsedTime = Timer
        Do
        If doc.getElementsByClassName("resultContainer").Length > 0 Then Exit Do
        If Timer - elapsedTime > MAX_WAIT_SEC Then
            MsgBox "Bekleme süresini aştı..... kod sonlandırıldı!"
            GoTo SafeExit:
        End If
        Loop

Set deg = doc.getElementsByTagName("dd")

    For Each metin In deg
   
     MsgBox metin.innerText
    Next metin
   
   
SafeExit:
ie.Quit

Set ie = Nothing

End Sub

Sub FindAndTerminate(ByVal strProcName As String)
    Dim objWMIService, objProcess, colProcess
    Dim strComputer, strList
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")
    If colProcess.Count > 0 Then
        For Each objProcess In colProcess
            objProcess.Terminate
        Next objProcess
    End If
End Sub

Teşekkürler Erdem Hocam
iyi ki varsınız, çok önemli olmayan ufak bir problem var, verileri sayfaya yazdırırken
IMEI numarası "3,55612E+14" gibi sayısal bir veri geliyor. olduğu gibi nasıl yazdırabiliriz?

c=2
r=2
        veri = metin.innerText
     
        Sht.Cells(r, c) = veri

 

[Erdem Akdemir]

IMEI numaraları aynı hücrelere yazılacaksa kodu çalıştırmadan önce Hücre biçimlendirden "Metin yapabilirsiniz" yada kodu içine aşağıdaki satırı ekleyin.

Range("A2").NumberFormat = "@"

 

[Erdem Akdemir]

Şöyle bir sorun var. Fazla sorgulama yapıldığında CAPTCHA doğrulaması istiyor.

 

[tamer42]

Şöyle bir sorun var. Fazla sorgulama yapıldığında CAPTCHA doğrulaması istiyor.

Teşekkürler
bu durumu aşmanın bir yolu yada öneriniz var mı Hocam?

 

[Erdem Akdemir]

Maalesef, yok.
XMLHTTP ile veri alma imkanı olursa belki istemeyebilir. XMLHTTP için gereken parametreleri ben göremedim.
Belki ustalar bakabilir. @Haluk bey mesela

 

[Haluk]

"gov.tr" uzantılı bir URL eğer CAPTCHA doğrulaması istiyorsa, fazla kurcalamamak gerekir....

.

 

[tamer42]

"gov.tr" uzantılı bir URL eğer CAPTCHA doğrulaması istiyorsa, fazla kurcalamamak gerekir....

.

çok doğru söylüyorsunuz Haluk hocam