Parsel Sorgusu için önemli bir konu

SAGULNET · 4 Eylül 2015

Sayın Excel.web.tr dostları size önemli bir soru sormak istiyorum.
İşlerimizde kullanacağım basit bir şey yapmak istiyorum, vatan - millet meselesi

Siz değerli dostlarım yardımcı olursa Allah bin kere razı olsun.

bir kod yardımı ile
https://parselsorgu.tkgm.gov.tr/ sitesine gireceğim ve

İdari Sorgu Coğrafi Sorgu dan coğrafi sorguyu seçecek, buradaki enleme ve boylama A1 VE A2 hücresindeki değerleri yazacak.

Yardım eden arkadaşlara çok teşekkürler.

halit3 · 4 Eylül 2015

İlgili web sitesindeki text nesnelerin her seferinde adı değişiyor baya uğraştırdı.
Aşağıdaki kodu bir dene bazen boş gelirse yeniden deneyiniz.

kod:

Kod:

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Sub verial()
Dim URL As String
Dim ie As Object

URL = "https://parselsorgu.tkgm.gov.tr/"
Set ie = CreateObject("InternetExplorer.Application")

With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 3

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
ie.document.all("cphMaster_rblSorguTip_1").Checked = True
ie.document.all("cphMaster_rblSorguTip_1").Click
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop

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

On Error Resume Next

sat = 1

Set objInputs = ie.document.getElementsByTagName("input")
For Each nesne In objInputs

If nesne.ID Like "*" & "cphMaster" & "*" = True Then
If sat = 3 Then
ie.document.all(nesne.ID).Value = Replace(Cells(1, "A").Value, ".", ",")

End If

If sat = 4 Then
ie.document.all(nesne.ID).Value = Replace(Cells(2, "A").Value, ".", ",")

End If
sat = sat + 1
'nesne.Click
End If
Next

Application.Wait (Now + TimeValue("00:00:01"))
ie.document.all("ctl00$cphMaster$btnSorgu").Click

'ie.Quit: Set ie = Nothing
End With

End Sub

systran · 5 Eylül 2015

Halit3 ün yazdığı kodlara ilave olarak eğer Sorgulama sonuçlarını da excele almak istersen şu örneği incele.
Sayfa1 deki A sütunu Enlem, B sütunu boylam bilgisini içerecek şekilde listelenen koordinatların bilgilerini (il, ilçe, ada parsel ...) sırayla sorgular ve yanlarına yazar.
https://drive.google.com/folderview?id=0By_vlGkmFxCCfnFPa1V0Y3BFNHVlMUE5R3hmRWE3azE3d3ZYUE9hTDhFbzVXczVXSWdHWDg&usp=sharing

Ömer BARAN · 5 Eylül 2015

Merhabalar, Sayın ÖZDEMİR ve Sayın systran.

Benim varsayılan internet tarayıcım Chrome.
Kodlar Internet Explorer'ı açtı, bilgiyi aldı ancak işlem bittikten sonra kapanmadı.

systran · 5 Eylül 2015

vba Chrome ile bu kadar ayrıntılı kullanılamıyor maalesef

Halit3 ün yazdığı kodların en sonunda ie.Quit satırı var, yorum satırı onu düzeltip deneyiniz.

SAGULNET · 7 Eylül 2015

Merhaba

Çok teşekkür ederim yardımlarınız için. Allah razı olsun hepinizden. halit3 ve systran ayrıca ellerinize sağlık.

halit3 · 7 Eylül 2015

SAGULNET' Alıntı:
Çok teşekkür ederim yardımlarınız için. Allah razı olsun hepinizden. halit3 ve systran ayrıca ellerinize sağlık.

Teşekkürler iyi çalışmalar

tamer42 · 7 Eylül 2015

Merhaba,

https://parselsorgu.tkgm.gov.tr
sitede ilgili bilgileri girerek; ekli görüntülerde olduğu gibi sorgulama yapabiliyoruz.

Sorgulama sonrasında “Koordinat İndir” butonuna basarak bir *.txt dosyası bilgisayarımıza kaydedilebilmektedir.

*.txt dosyasının kaydedilme işleminin Excel ortamında bir kod oluşturarak yapılması mümkün olabilir mi?

Teşekkürler, İyi Çalışmalar.

SAGULNET · 7 Eylül 2015

kodun sonunda trs ve tds hata verdi. Acaba bunu nasıl düzeltiriz ?

dim trs,tds as ... gibi birşey tanımlamam lazım sanırım

Dim tbl As Object
Application.Wait (Now + TimeValue("00:00:01"))
Set tbl = ie.Document.getElementsByTagName("table")(5) '5. tablo arama sonuçlarının olduğu tablo

Dim trs As Tag
Set trs = tbl.getElementsByTagName("tr")(1)
Set tds = trs.getElementsByTagName("td")

Dim c As Integer
For c = 0 To tds.Length - 1
Sayfa1.Range("L" & iii).Offset(0, c).Value = tds(c).innerText
Next c

halit3 · 7 Eylül 2015

Bu kod ilgili sayfada A2 hücresinden aşağıya kadar Enlem, B2 hücresinden aşağıya kadar boylam kordinatlarını kod yatay olarak ilgili hücrelere getirmektedir.

kod:

Kod:

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Sub verial10()
Dim URL As String
Dim ie As Object

yeni_dosya_adı = ActiveWorkbook.Name

Columns("C:K").ClearContents
son = Cells(Rows.Count, "a").End(3).Row

sat1 = 6

URL = "https://parselsorgu.tkgm.gov.tr/"
Set ie = CreateObject("InternetExplorer.Application")

With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 6


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

For k = 1 To 3
For i = 2 To son

If Cells(i, "c").Value <> "" Then
GoTo atla1
End If

ie.document.all("cphMaster_rblSorguTip_1").Checked = True
ie.document.all("cphMaster_rblSorguTip_1").Click
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop


On Error Resume Next
sat = 1
Set objInputs = ie.document.getElementsByTagName("input")

For Each nesne In objInputs

deg1 = Split(nesne.ID, "rblSorguTip")
If UBound(deg1) > 0 Then
GoTo atla2
End If
deg2 = Split(nesne.ID, "btnSorgu")
If UBound(deg2) > 0 Then
GoTo atla2
End If
If nesne.ID Like "*" & "cphMaster" & "*" = True Then
ie.document.all(nesne.ID).Value = Replace(Cells(i, sat).Value, ".", ",")

sat = sat + 1
End If
atla2:
Next

Application.Wait (Now + TimeValue("00:00:01"))
ie.document.all("ctl00$cphMaster$btnSorgu").Click

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

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

Set t = ie.document.getElementsByTagName("table").Item(5)

If Cells(1, "c") = "" Then
For j = 0 To t.Cells.Length - 1
Cells(1, j + 3) = t.Rows(0).Cells(j).innerText
Next
End If

For j = 0 To t.Cells.Length - 1
Cells(i, j + 3) = t.Rows(1).Cells(j).innerText
Next

atla1:
Next i


Next k

'ie.Quit: Set ie = Nothing
End With

Windows(yeni_dosya_adı).Activate

MsgBox "işlem tamam"
End Sub

systran · 7 Eylül 2015

Merhaba;
Rahatsız ediyorum ama son bir sorum olacak. Şimdi bir parselin ili ilçesinden sorgulamak istesek yani https://parselsorgu.tkgm.gov.tr/ 'de idari sorguda listeden girdiğimiz bir ili seçse mesela Ankara oradan ilçesini ... sırasıyla hepsini seçip alsa nasıl birşey yazmamız gerekir.

istediğiniz şeyi yapmaya çalışıyorum ama takıldığım bir nokta var. İstanbulu yazı olarak "İstanbul" veya 34 olarak seçtiremiyorum, kod karşılığı olan 56 (alakasız bi kod) ile seçilebiliyor. mesela Adana 01 değil 23 gibi. aynı sorun ilçelerde de geçerli ??? bunun sizde bir karşılık tablosu var mı?

halit3 · 7 Eylül 2015

Aslında ben web den veri alma işlemlerine bakmamaya çalışıyorum.
Sebebi web sitelerindeki tablolar sık sık değişiyor ve güvenlik sorgusu ile karşılaşıyoruz.

Bu gibi durumda bu veri alma işleminin hepsi bozulacaktır hatta yapılması bile olanaksız hale gelecektir.

Bu seferlik kod yazdım baya uğraştırdı beni

Açıklama.
A Sütununa bu başlıkları yaz

A1=İl
A2 =İlçe
A3=Mahalle/Köy
A4=Ada
A5=Parsel

B Sütununa Bu başlıklara ait değerleri yaz

B1=Ankara
B2 =Şereflikoçhisar
B3=Akarca
B4=111
B5=6

kodu çalıştır

kod:

Kod:

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Sub aaaverial10()
Dim URL As String
Dim ie As Object

yeni_dosya_adı = ActiveWorkbook.Name

Range("c2:k2").ClearContents


ReDim veri(13)
ReDim yer(13)

yer(1) = "cphMaster_rblSorguTip"
yer(2) = "cphMaster_rblSorguTip_0"
yer(3) = "cphMaster_rblSorguTip_1"
yer(4) = "cphMaster_tblIdariSorguAlan"
yer(5) = "cphMaster_IlLabelYatay"
yer(6) = "cphMaster_IlceLabelYatay"
yer(7) = "cphMaster_MahalleLabelYatay"
yer(8) = "cphMaster_AdaLabelYatay"
yer(9) = "cphMaster_ParselLabelYatay"
yer(10) = "cphMaster_btnSorgu"
yer(11) = "cphMaster_tblMesaj"
yer(12) = "cphMaster_lMesaj"
yer(13) = "cphMaster_map"


URL = "https://parselsorgu.tkgm.gov.tr/"
Set ie = CreateObject("InternetExplorer.Application")

With ie
.Navigate URL
.Visible = 1
ShowWindow ie.hwnd, 6


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


On Error Resume Next

Set objInputs = ie.document.getElementsByTagName("*")
sat2 = 0
For Each nesne In objInputs

If Val(Len(nesne.ID)) > 0 Then
deg3 = nesne.ID
If deg3 Like "*" & "cphMaster" & "*" = True Then

deg1 = 0
For m = 1 To 13

If Trim(nesne.ID) = yer(m) Then
deg1 = 1
Exit For
End If
Next

If deg1 = 0 Then
'MsgBox nesne.ID
sat2 = sat2 + 1
veri(sat2) = nesne.ID 'Trim(Replace(nesne.ID, "_", " "))
End If
End If
End If

Next nesne

If sat2 > 0 Then
For t = 1 To sat2
deg3 = veri(t)

If deg3 Like "*" & "cphMaster" & "*" = True Then


If t = 1 Then
hucre = Trim(Cells(1, "b").Text)
ElseIf t = 2 Then
hucre = Trim(Cells(2, "b").Text)
ElseIf t = 3 Then
hucre = Trim(Cells(3, "b").Text)
ElseIf t = 4 Then
hucre = Trim(Cells(4, "b").Text)
ElseIf t = 5 Then
hucre = Trim(Cells(5, "b").Text)
End If

For r = 1 To Val(ie.document.all(deg3).Length)

If hucre = Trim(ie.document.all(deg3)(r).Text) Then
son5 = r
'MsgBox hucre & Chr(10) & Trim(ie.document.all(deg3)(r).Text)
ie.document.all(deg3).selectedIndex = son5
Exit For
End If
Next r


ie.document.all(deg3).OnChange
Application.Wait (Now + TimeValue("00:00:01"))
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop

End If
Next t

Application.Wait (Now + TimeValue("00:00:01"))
ie.document.all("cphMaster_btnSorgu").Click

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

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

Set t = ie.document.getElementsByTagName("table").Item(5)

For j = 0 To 8 't.Cells.Length - 1
Cells(2, j + 3) = t.Rows(1).Cells(j).innerText
Next


End If
'ie.Quit: Set ie = Nothing
End With

Windows(yeni_dosya_adı).Activate

MsgBox "işlem tamam"
End Sub

systran · 7 Eylül 2015

Aslında ben web den veri alma işlemlerine bakmamaya çalışıyorum.
Sebebi web sitelerindeki tablolar sık sık değişiyor ve güvenlik sorgusu ile karşılaşıyoruz.

kesinlikle güvenlik sorgusu eklemeleri yakındır

halit3 · 7 Eylül 2015

Yukarıdaki mesajımda yazmış olduğum kod ile ilgili İl,İlçe,Mah/köy,Ada,Parsel bire bir sistemde kayıtlı ise veri alacaktır aksi taktirde veri almayacaktır.

halit3 · 7 Eylül 2015

systran' Alıntı:
kesinlikle güvenlik sorgusu eklemeleri yakındır

Evet mutlaka güvenlik sorgusunu ekleyeceklerdir.

Hayırlısı bakalım.

SAGULNET · 7 Eylül 2015

ReDim veri(13)
ReDim yer(13)

yer(1) = "cphMaster_rblSorguTip"
yer(2) = "cphMaster_rblSorguTip_0"
yer(3) = "cphMaster_rblSorguTip_1"
yer(4) = "cphMaster_tblIdariSorguAlan"
yer(5) = "cphMaster_IlLabelYatay"
yer(6) = "cphMaster_IlceLabelYatay"
yer(7) = "cphMaster_MahalleLabelYatay"
yer(8) = "cphMaster_AdaLabelYatay"
yer(9) = "cphMaster_ParselLabelYatay"
yer(10) = "cphMaster_btnSorgu"
yer(11) = "cphMaster_tblMesaj"
yer(12) = "cphMaster_lMesaj"
yer(13) = "cphMaster_map"

burada hata verdi ama

compile error: Expected array

ne yapmam gerekiyor ?

halit3 · 7 Eylül 2015

SAGULNET' Alıntı:
ReDim veri(13)
ReDim yer(13)
burada hata verdi ama
compile error: Expected array
ne yapmam gerekiyor ?

Sorgularda ne kullandınız
İl,ilçe vb

SAGULNET · 7 Eylül 2015

halit3' Alıntı:
Sorgularda ne kullandınız
İl,ilçe vb

Daha yapamadım ki. Çalıştırdım szin yazdığınızı ama başka bir excel dosyasında yapınca hata verdi ?

halit3 · 7 Eylül 2015

SAGULNET' Alıntı:
Daha yapamadım ki. Çalıştırdım szin yazdığınızı ama başka bir excel dosyasında yapınca hata verdi ?

Bir şey anlamadım 12 nolu mesajımdaki işlemleri yaptınızmı.

halit3 · 7 Eylül 2015

Kodları nereye ekleyeceğinizi bilmediğinizi söylemeyin sakın

Eğer onuda bilmiyorsanız anlatayım.

Parsel Sorgusu için önemli bir konu

SAGULNET

halit3

Uzman

systran

Destek Ekibi

Ömer BARAN

Uzman

systran

Destek Ekibi

SAGULNET

halit3

Uzman

tamer42

Destek Ekibi

Ekli dosyalar

SAGULNET

halit3

Uzman

systran

Destek Ekibi

halit3

Uzman

systran

Destek Ekibi

halit3

Uzman

halit3

Uzman

SAGULNET

halit3

Uzman

SAGULNET

halit3

Uzman

halit3

Uzman