Parsel Sorgusu için önemli bir konu

tamer42 · 14 Eylül 2015

halit3' Alıntı:
Aşağıdaki videoyu irdeleyin 1 dakika 39 saniyedeki görsel video da text nesnesi açılyor.

görsel video

Bu uygulamanın tamamını kod yapıyor mause ile manuel müdahale edilmiyor.

[FLASH]http://www.excel.web.tr/derres/halit/tkgm2.swf ] görsel video [/FLASH]

Sn Halit merhaba
bence tüm sorun versiyon farkından kaynaklanıyor. Win7 ve Internet Explorer 11

Kod:

IE.document.all("cphMaster_btnKaydet").Click

bu satır çalışmıyor. her şey burada bitiyor.

Teşekkürler
iyi akşamlar.

halit3 · 15 Eylül 2015

Bu kod
Windows7 işletim sisteminde,Excell ofis 2007 de,İnternet Explorer 9.da denendi çalışıyor.

Kod:

#If Win64 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
#Else
#End If



Sub verial1()
Dim URL As String
Dim IE As Object

yeni_dosya_adı = ThisWorkbook.Name
Range("c2:k2").ClearContents


ReDim veri1(13)
ReDim veri2(13)

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


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

With IE
.Navigate URL
.Visible = 1
'ShowWindow IE.hWnd, 2

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) = veri2(m) Then
deg1 = 1
Exit For
End If
Next

If deg1 = 0 Then
sat2 = sat2 + 1
veri1(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 = veri1(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
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

'-------------------------------------------------
'dosyayı açmak için
Application.Wait (Now + TimeValue("00:00:01"))
IE.document.all("cphMaster_btnKaydet").Click
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:02"))
'SendKeys "{LEFT}", True
'Application.Wait (Now + TimeValue("00:00:01"))

'SendKeys ("{TAB 5}"), True

SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True
'-------------------------------------------------

Application.Wait (Now + TimeValue("00:00:03"))
Windows(yeni_dosya_adı).Activate
acik_olan_metin_dosyasini_ac1
Application.Wait (Now + TimeValue("00:00:02"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("00:00:01"))

SendKeys ("{Enter}"), True

End If

IE.Quit: Set IE = Nothing
End With

MsgBox "işlem tamam"
End Sub

Sub acik_olan_metin_dosyasini_ac1()


yer = ThisWorkbook.Name
Dosya2 = ThisWorkbook.Path & "\Dosyalar"

If CreateObject("Scripting.FileSystemObject").FolderExists(Dosya2) = False Then
MkDir Dosya2
End If

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")




uzanti = fL.GetExtensionName(yer)

If uzanti = "xls" Then
FileFormatNum = -4143
ElseIf uzanti = "xlsm" Then
FileFormatNum = 52
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
ElseIf uzanti = "xlsb" Then
FileFormatNum = 50
Else
FileFormatNum = 56
End If



ReDim dosya(50)
i = 0
Set Word = CreateObject("Word.Application")
Set Tasks = Word.Tasks
For Each task In Tasks
If task.Visible Then
If Mid(task.Name, 1, 24) = "tkgm-parsel-sorgu-sonuc-" Or Mid(task.Name, 1, 18) = "Yeni Metin Belgesi" Then
i = i + 1

If Tasks.Exists(task.Name) Then
With Tasks(task.Name)
.Activate
Application.Wait (Now + TimeValue("0:00:0"))
SendKeys ("{ENTER}"), True
Application.Wait (Now + TimeValue("0:00:0"))
SendKeys "^{a}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^{c}"
Application.Wait (Now + TimeValue("0:00:01"))

SendKeys "%{TAB}", True
Windows(yer).Activate

Dim wbDest As Workbook
Set wbDest = Workbooks.Add
ActiveSheet.Paste Destination:=Range("a1")

Application.CutCopyMode = False
Application.DisplayAlerts = False
yer1 = Replace(Replace(Replace(fL.GetBaseName(task.Name), "-", " "), "[", " "), "]", "")
yer2 = fL.GetBaseName(yer1)
say = " " & fL.GetFolder(Dosya2).Files.Count
wbDest.SaveAs Dosya2 & "\" & yer2 & say & ".xls"

wbDest.SaveAs Dosya2 & "\" & yer2 & say & "." & uzanti, FileFormat:=FileFormatNum


wbDest.Close SaveChanges:=True
Application.DisplayAlerts = True
.Activate
.Close
Word.Quit
Exit For
End With


End If
End If
End If
Next
Application.Wait (Now + TimeValue("0:00:01"))
'SendKeys "{NUMLOCK}", True
Shell "TASKKILL /F /IM WINWORD.EXE"
'Shell "tskill WINWORD.EXE"
If i = 0 Then Word.Quit: MsgBox "açık txt dosyası yok": Exit Sub

End Sub

tamer42 · 15 Eylül 2015

halit3' Alıntı:

Bu kod
Windows7 işletim sisteminde,Excell ofis 2007 de,İnternet Explorer 9.da denendi çalışıyor.

Kod:

#If Win64 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
#Else
#End If



Sub verial1()
Dim URL As String
Dim IE As Object

yeni_dosya_adı = ThisWorkbook.Name
Range("c2:k2").ClearContents


ReDim veri1(13)
ReDim veri2(13)

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


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

With IE
.Navigate URL
.Visible = 1
'ShowWindow IE.hWnd, 2

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) = veri2(m) Then
deg1 = 1
Exit For
End If
Next

If deg1 = 0 Then
sat2 = sat2 + 1
veri1(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 = veri1(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
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

'-------------------------------------------------
'dosyayı açmak için
Application.Wait (Now + TimeValue("00:00:01"))
IE.document.all("cphMaster_btnKaydet").Click
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:02"))
'SendKeys "{LEFT}", True
'Application.Wait (Now + TimeValue("00:00:01"))

'SendKeys ("{TAB 5}"), True

SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True
'-------------------------------------------------

Application.Wait (Now + TimeValue("00:00:03"))
Windows(yeni_dosya_adı).Activate
acik_olan_metin_dosyasini_ac1
Application.Wait (Now + TimeValue("00:00:02"))
SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("00:00:01"))

SendKeys ("{Enter}"), True

End If

IE.Quit: Set IE = Nothing
End With

MsgBox "işlem tamam"
End Sub

Sub acik_olan_metin_dosyasini_ac1()


yer = ThisWorkbook.Name
Dosya2 = ThisWorkbook.Path & "\Dosyalar"

If CreateObject("Scripting.FileSystemObject").FolderExists(Dosya2) = False Then
MkDir Dosya2
End If

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")




uzanti = fL.GetExtensionName(yer)

If uzanti = "xls" Then
FileFormatNum = -4143
ElseIf uzanti = "xlsm" Then
FileFormatNum = 52
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
ElseIf uzanti = "xlsb" Then
FileFormatNum = 50
Else
FileFormatNum = 56
End If



ReDim dosya(50)
i = 0
Set Word = CreateObject("Word.Application")
Set Tasks = Word.Tasks
For Each task In Tasks
If task.Visible Then
If Mid(task.Name, 1, 24) = "tkgm-parsel-sorgu-sonuc-" Or Mid(task.Name, 1, 18) = "Yeni Metin Belgesi" Then
i = i + 1

If Tasks.Exists(task.Name) Then
With Tasks(task.Name)
.Activate
Application.Wait (Now + TimeValue("0:00:0"))
SendKeys ("{ENTER}"), True
Application.Wait (Now + TimeValue("0:00:0"))
SendKeys "^{a}"
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^{c}"
Application.Wait (Now + TimeValue("0:00:01"))

SendKeys "%{TAB}", True
Windows(yer).Activate

Dim wbDest As Workbook
Set wbDest = Workbooks.Add
ActiveSheet.Paste Destination:=Range("a1")

Application.CutCopyMode = False
Application.DisplayAlerts = False
yer1 = Replace(Replace(Replace(fL.GetBaseName(task.Name), "-", " "), "[", " "), "]", "")
yer2 = fL.GetBaseName(yer1)
say = " " & fL.GetFolder(Dosya2).Files.Count
wbDest.SaveAs Dosya2 & "\" & yer2 & say & ".xls"

wbDest.SaveAs Dosya2 & "\" & yer2 & say & "." & uzanti, FileFormat:=FileFormatNum


wbDest.Close SaveChanges:=True
Application.DisplayAlerts = True
.Activate
.Close
Word.Quit
Exit For
End With


End If
End If
End If
Next
Application.Wait (Now + TimeValue("0:00:01"))
'SendKeys "{NUMLOCK}", True
Shell "TASKKILL /F /IM WINWORD.EXE"
'Shell "tskill WINWORD.EXE"
If i = 0 Then Word.Quit: MsgBox "açık txt dosyası yok": Exit Sub

End Sub

Sn Halit merhaba,

Şimdi tamam, istediğim gibi çalıştı....

her şey için çok teşekkürler, emeğinize sağlık......

iyi çalışmalar.

halit3 · 15 Eylül 2015

tamer42' Alıntı:
Sn Halit merhaba,

Şimdi tamam, istediğim gibi çalıştı....

her şey için çok teşekkürler, emeğinize sağlık......

iyi çalışmalar.

Teşekkürler iyi çalışmalar

tamer42 · 16 Eylül 2015

Sn Halit Merhaba,

Şu an için excel dosyada il - ilçe ve Mahalle/Köy isimleri manuel yazılmakta ve veritabanına uygun yazma konusunda hata yapılabilmektedir.

İl- İlçe- Mahalle/Köy isimlerinin doğru girilmesi için bu hususta iyi bir veritabanına ihtiyaç vardır.

Benim bu konuda daha önce düşündüğüm bir yöntemi sizinle paylaşmak istiyorum.

Excel sayfasına bir web browser nasıl yerleştirildikten sonra;
Bu browser üzerinden https://parselsorgu.tkgm.gov.tr/ yi açıyor ve istediğimiz sorgulamayı (hiç manuel veri girmeden) sadece seçimlerle yapabiliyoruz.

bu konuda sizin yaklaşımınız nasıl olur?

Yardımlarınız için şimdiden Teşekkürler,

iyi Çalışmalar.

halit3 · 16 Eylül 2015

Ben bu konunun kapandığını sanıyordum.
Webten veri almak ile ilgili bir çok bölümde ve bu konuda da mesajlarımın birinde şunu dile getirdim bu site de zamanla güvenlik uygulamasına geçebilir bu tür uygulamalarla uğraşmak hem zahmetli hem meşakkatli hem zaman meselesi var

Diğer taraftan mesajlarımdan bir tanesinde il,ilçe,köy adları olan bir dosyam mevcuttur ondan yararlanabilirsiniz.

jilazem · 19 Eylül 2015

Merhaba yapılan çalışma tam aradığım birşey di çok teşekkür ederim. Parsel sorgu ekranında yol tarifine basıldığında parselin koordinatları google map üzerine atılıyor bunu nasıl alabiliriz?
systran çalışmanın son halini paylaşabilirmisin ? Tabi senin için uygun olur sa
Son olarak pasor diye bir yazılım var android ve pc versiyonları verileri çekiyor ve google earth içine atabiliyor.

SAGULNET · 5 Ekim 2015

Bu kodları visual studio da yazmayı denedim. çalıştırdım ama aşağıdaki gibi bir hata aldım. DİM ... AS ... BUNLARDA MI SIKINTI VAR YADA ÖZEL BİRŞEYLER Mİ YAZMAM GEREKİYOR. YANİ EXCELDE ÇALIŞIYOR AMA VİSUAL STUİODA ÇALIŞTIRAMADIM. Örnek olarak açıyor, ANKARA yı tıklatıyor ama sonra aşağıdaki gibi hata veriyor.,

Kod:

Sub verial1()
        Dim URL As String
        Dim IE As Object


        Dim veri1, veri2 As Object

        ReDim veri1(13)
        ReDim veri2(13)

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


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

        With IE
            .Navigate(URL)
            .Visible = 1
            'ShowWindow IE.hWnd, 2

            Do Until IE.ReadyState = 4 : DoEvents() : Loop
            Do While IE.Busy : DoEvents() : Loop
            Dim sat2 As Integer
            Dim deg1 As Integer
            Dim son5 As String


            Dim objInputs As Object
            Dim deg3 As String
            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) = veri2(m) Then
                                deg1 = 1
                                Exit For
                            End If
                        Next

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

            Next nesne

            ' On Error Resume Next
            Dim t As Integer
            If sat2 > 0 Then
                For t = 1 To sat2
                    deg3 = veri1(t)

                    If deg3 Like "*" & "cphMaster" & "*" = True Then
                        Dim hucre As String = ""

                        If t = 1 Then hucre = Trim("Ankara")
                        If t = 2 Then hucre = Trim("Akyurt")
                        If t = 3 Then hucre = Trim("Akyurt")
                        If t = 4 Then hucre = Trim("0")
                        If t = 5 Then hucre = Trim("1")

                        System.Threading.Thread.Sleep(2000)
                        ' On Error Resume Next


                        For r = 1 To Val(IE.document.all(deg3).Length)
                            If hucre = Trim(IE.document.all(deg3)(r).Text) Then
                                son5 = r
                                IE.document.all(deg3).selectedIndex = son5
                                Exit For
                            End If
                        Next r

                        System.Threading.Thread.Sleep(2000)

                        IE.document.all(deg3).onchange
                        System.Threading.Thread.Sleep(2000)
                        '  Application.Wait(Now + TimeValue("00:00:01"))
                        Do Until IE.ReadyState = 4 : DoEvents() : Loop
                        Do While IE.Busy : DoEvents() : Loop

                    End If
                Next t




                System.Threading.Thread.Sleep(2000)
                ' 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
                System.Threading.Thread.Sleep(2000)
                ' Application.Wait(Now + TimeValue("00:00:01"))


                t = IE.document.getElementsByTagName("table").Item(5)
                System.Threading.Thread.Sleep(2000)
                '    For j = 0 To 8 't.Cells.Length - 1
                '   Cells(2, j + 3) = t.Rows(1).Cells(j).innerText
                '  Next

                '-------------------------------------------------


            End If

            '  IE.Quit : IE = Nothing
        End With
    End Sub

bu kısımda hata var.

Kod:

 For r = 1 To Val(IE.document.all(deg3).Length)
                            If hucre = Trim(IE.document.all(deg3)(r).Text) Then
                                son5 = r
                                IE.document.all(deg3).selectedIndex = son5
                                Exit For
                            End If
                        Next r

hatada An unhandled exception of type 'System.NotSupportedException' occurred in Microsoft.VisualBasic.dll Additional information: HRESULT özel durum döndürdü: 0x800A01B6 yazıyor..

halit3 · 5 Ekim 2015

Projenizi ekleyinde bir bakalım

Gördüğüm kadarı ile

Kod:

Dim hucre As String = ""

If t = 1 Then hucre = Trim("Ankara")
If t = 2 Then hucre = Trim("Akyurt")
If t = 3 Then hucre = Trim("Akyurt")
If t = 4 Then hucre = Trim("0")
If t = 5 Then hucre = Trim("1")

yukarıdaki bölümü silin aşağıdaki bölümü ekleyin

Kod:

If t = 1 Then
hucre = "Ankara"
ElseIf t = 2 Then
hucre = "Akyurt"
ElseIf t = 3 Then
hucre = "Akyurt"
ElseIf t = 4 Then
hucre = "0"
ElseIf t = 5 Then
hucre = "0"
End If

burada t döngüsü hep bir de duruyor herhalde onun için hata alıyor olabilirsiniz.

SAGULNET · 5 Ekim 2015

halit3' Alıntı:
Projenizi ekleyinde bir bakalım

Gördüğüm kadarı ile

Kod:

Dim hucre As String = "" If t = 1 Then hucre = Trim("Ankara") If t = 2 Then hucre = Trim("Akyurt") If t = 3 Then hucre = Trim("Akyurt") If t = 4 Then hucre = Trim("0") If t = 5 Then hucre = Trim("1")

yukarıdaki bölümü silin aşağıdaki bölümü ekleyin

Kod:

If t = 1 Then hucre = "Ankara" ElseIf t = 2 Then hucre = "Akyurt" ElseIf t = 3 Then hucre = "Akyurt" ElseIf t = 4 Then hucre = "0" ElseIf t = 5 Then hucre = "0" End If

burada t döngüsü hep bir de duruyor herhalde onun için hata alıyor olabilirsiniz.

Denedim ama olmadı. Acaba başka bir yerdemi sorun. Ayrıca şöyle bir durum var aynı kodu EXCEL VBA'DA yazdım çalışıyor.

SAGULNET · 5 Ekim 2015

Ankara'yı yazdırabiliyorum.ama sonrasında aşağıdaki gibi uyarı alıyorum. ;
Kütüphaneye birşeyler mi eklemem lazım nedir ?

pc windows 8 visual studio 2015 bunlarla alakalı olabilir mi ?

yada dim.. as string.. vs yazıyoruz bunlarda mı hatam var ?

halit3 · 5 Ekim 2015

Bu kod vb6 da çalışıyor.

Kod:

#If Win64 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
#Else
#End If

Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)


Private Sub Command1_Click()
Dim URL As String
Dim IE As Object

ReDim veri1(13)
ReDim veri2(13)

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


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

With IE
.Navigate URL
.Visible = 1
ShowWindow IE.hWnd, 1


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) = veri2(m) Then
deg1 = 1
Exit For
End If
Next

If deg1 = 0 Then
sat2 = sat2 + 1
veri1(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 = veri1(t)

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


If t = 1 Then
hucre = "Ankara"
ElseIf t = 2 Then
hucre = "Akyurt"
ElseIf t = 3 Then
hucre = "Akyurt"
ElseIf t = 4 Then
hucre = "0"
ElseIf t = 5 Then
hucre = "1"
End If

For r = 1 To Val(IE.document.All(deg3).Length)
If hucre = Trim(IE.document.All(deg3)(r).Text) Then
son5 = r
IE.document.All(deg3).selectedIndex = son5
Exit For
End If
Next r


IE.document.All(deg3).onchange
Sleep 1000
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

End If
Next t

Sleep 1000
IE.document.All("cphMaster_btnSorgu").Click

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

'-------------------------------------------------

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

MsgBox "işlem tamam"
End Sub

dosya

SAGULNET · 5 Ekim 2015

halit3' Alıntı:

Bu kod vb6 da çalışıyor.

Kod:

#If Win64 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
#Else
#End If

Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)


Private Sub Command1_Click()
Dim URL As String
Dim IE As Object

ReDim veri1(13)
ReDim veri2(13)

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


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

With IE
.Navigate URL
.Visible = 1
ShowWindow IE.hWnd, 1


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) = veri2(m) Then
deg1 = 1
Exit For
End If
Next

If deg1 = 0 Then
sat2 = sat2 + 1
veri1(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 = veri1(t)

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


If t = 1 Then
hucre = "Ankara"
ElseIf t = 2 Then
hucre = "Akyurt"
ElseIf t = 3 Then
hucre = "Akyurt"
ElseIf t = 4 Then
hucre = "0"
ElseIf t = 5 Then
hucre = "1"
End If

For r = 1 To Val(IE.document.All(deg3).Length)
If hucre = Trim(IE.document.All(deg3)(r).Text) Then
son5 = r
IE.document.All(deg3).selectedIndex = son5
Exit For
End If
Next r


IE.document.All(deg3).onchange
Sleep 1000
Do Until IE.ReadyState = 4: DoEvents: Loop
Do While IE.Busy: DoEvents: Loop

End If
Next t

Sleep 1000
IE.document.All("cphMaster_btnSorgu").Click

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

'-------------------------------------------------

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

MsgBox "işlem tamam"
End Sub

dosya

Visual studio da çalışmıyor. Benim gördüğüm şu;

objInputs ve NESNE.ID'de sorun var gibi. bunları dim as string gibi tanımlayıcılarda sorun var gibi bunu çözsek olay bitti gibi

Murat OSMA · 15 Ocak 2016

[YOUTUBE]nNeyq_j_oEw[/YOUTUBE]

İstek: Yönetici ya da Moderatör arkadaşlar bu konuyu Web'ten Bilgi Sorgulama başlığına taşıyabilir mi?

oydemir · 20 Ocak 2016

halit bey ben de bu konuda bir şey sormak isterim. görüntü Google Earth açtırmak mümkün mü.
kadastronun sitesinde kml veya kmz uzantılı saklama imkanı yok .Google Earth saklama imkanı bulunmaktadır. kml uzantılı ve ya kmz uzantılı dosyalarında haritacı olarak netcad7 programında
direk açarak işlem yapma şansımız oluyor .ilginize teşekkürler ayrıca eline sağlık

jilazem · 20 Ocak 2016

http://www.cadplugin.com/ adresinde emlakcad var içerisinde bulunan pasor mdülü tüm işlevleri yerine getiriyor.. Bu nu excelde yapabilmek süper olurdu...

oydemir · 20 Ocak 2016

resmi dairelerde emlakcad çalışmamaktadır.

SaLLaNaNLaMBa · 7 Mart 2016

konteyner sorgulama

Merhabalar,

Buna benzer benimde bir sorum olacak,

Ekte Konteyner numaraların olduğu Excell listesinde

http://www.kumport.com.tr/kon_izleme.html
adresinden veya http://www.marport.com.tr/marport_online/konteyner_sorgulama.html
adresinden konteyner in hangi tarihte girdiğini excell in ilgili konteyner e yazmasını istiyorum

konteyner numarasının hangi limana ait olduğunu bilmiyorum sorulamada 2 sayfayada bakıp oradan alacak verileri?
İlgilenen arkadaşlara şimdiden teşekkürler.

SaLLaNaNLaMBa · 8 Mart 2016

bakabilen oldu mu?

GFKFOX · 15 Aralık 2016

https://parselsorgu.tkgm.gov.tr adresinden "pasor" excele bilgiler gelmiyor yardımcı olursanız sevinirim. zannedersem https://parselsorgu.tkgm.gov.tr adresinde sorgulama özellikleri değiştiğinden kaynaklandı lütfen yardımlarınızı bekliyorum.

Parsel Sorgusu için önemli bir konu

tamer42

Destek Ekibi

halit3

Uzman

tamer42

Destek Ekibi

halit3

Uzman

tamer42

Destek Ekibi

Ekli dosyalar

halit3

Uzman

jilazem

SAGULNET

halit3

Uzman

SAGULNET

SAGULNET

halit3

Uzman

SAGULNET

Murat OSMA

Altın Üye

oydemir

jilazem

oydemir

SaLLaNaNLaMBa

Ekli dosyalar

SaLLaNaNLaMBa

GFKFOX