Parsel Sorgusu için önemli bir konu

[halit3]

aldığım hata ile ilgili ekran görüntüsü ektedir, yardımcı olabilirseniz sevinirim.

(win 10, excel 2013)

64 bit sorunu

Private Declare

yukarıdaki bölümlere PtrSafe bunu eklemelisiniz.

Private Declare [COLOR="Red"]PtrSafe[/COLOR]

 

[tamer42]

Merhaba,

Kodları çalıştırınca; aldığım hata ile ilgili ekran görüntüleri ektedir, yardımcı olabilirseniz sevinirim.

aşağıdaki satırda hata vermekte;

[B][color=red]Do Until IE.ReadyState = 4[/color][/B]: DoEvents: Loop

(Win 7, Excel 2010)

İyi Çalışmalar.

 

[halit3]

Benim yüklediğim dosyada kodlar çalışıyor çalıştığına dair video yükleniyor ara ara deneyiniz.

görsel video

 

[systran]

Merhaba,

Kodları çalıştırınca; aldığım hata ile ilgili ekran görüntüleri ektedir, yardımcı olabilirseniz sevinirim.

aşağıdaki satırda hata vermekte;

[B][color=red]Do Until IE.ReadyState = 4[/color][/B]: DoEvents: Loop

(Win 7, Excel 2010)

İyi Çalışmalar.

Automation error ara ara benim denemelerimde de veriyordu. END yapınca, bazen DEBUG, bazen Excel kapatıp açınca sorun kalmıyor.

 

[tamer42]

Automation error ara ara benim denemelerimde de veriyordu. END yapınca, bazen DEBUG, bazen Excel kapatıp açınca sorun kalmıyor.

Merhaba,
https://parselsorgu.tkgm.gov.tr sitesini;
Internet Seçenekleri >> Güvenlik >> Güvenilir Siteler' e eklemiştim. Buradan kaldırınca
"Automation error:
The object invoked has disconnected from its clients" sorunu çözüldü,

verial1 ' de işlem tamam,

Yalnız acik_olan_metin_dosyasini_ac1 kodunda aşağıdaki satırda ekli hata mesajını veriyor.

[color=red][B]Shell "tskill WINWORD.EXE"[/B][/color]

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

İyi Pazarlar....

 

[halit3]

Merhaba,
https://parselsorgu.tkgm.gov.tr sitesini;
Internet Seçenekleri >> Güvenlik >> Güvenilir Siteler' e eklemiştim. Buradan kaldırınca
"Automation error:
The object invoked has disconnected from its clients" sorunu çözüldü,

verial1 ' de işlem tamam,

Yalnız acik_olan_metin_dosyasini_ac1 kodunda aşağıdaki satırda ekli hata mesajını veriyor.

[color=red][B]Shell "tskill WINWORD.EXE"[/B][/color]

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

İyi Pazarlar....

O bölümü silin gitsin

 

[tamer42]

O bölümü silin gitsin

bu satırı sildim;

verial1() çalıştırınca

"açık txt dosyası yok" mesajı veriyor....

teşekkürler,
iyi akşamlar.

 

[tamer42]

Benim yüklediğim dosyada kodlar çalışıyor çalıştığına dair video yükleniyor ara ara deneyiniz.

görsel video

Sn Halit Win7 için kodda bir düzenleme yapmak gerekir mi?

Ekli resim.

 

[tamer42]

Merhaba,
Nihayet kod çalıştığında indirilen txt dosyayı ("tkgm-parsel-sorgu-sonuc-") nereye kaydedildiğini buldum.

C:\Users\User\AppData\Local\Microsoft\Windows\Temporary Internet Files\......\.......\

klasörü altına kaydetmekte,

'-------------------------------------------------
'dosyayı açmak için
Application.Wait (Now + TimeValue("00:00:11"))
IE.document.all("[B]cphMaster_[color=red]btnKaydet[/B][/color]").Click

txt dosyayı klasör altına kaydetmek yerine; txt dosyayı direkt Açma yada Farklı Kaydet yapılamaz mı?

_btnKaydet yerine _btnAc veya _btnFarklıKaydet gibi....


teşekkürler,
iyi geceler...

 

[systran]

şu yöntemi denediniz mi?
bir tane indirme yönetici program kurup, indirme linklerine tıklayınca (mevcut kodlarla zaten bu aşamaya kadar gelindi) direk indirmeye başlasa???

ben biraz ısrarcı davranacağım kusura bakmayın ama bütün bu kaydet, farklı kaydet, yol seç işlemlerini gereksiz kılacağını teorik olarak düşündüğüm, bahsettiğim yöntemi kullanıp denediniz mi? umarım yanlış anlamazsınız.

 

[halit3]

Merhaba,
Nihayet kod çalıştığında indirilen txt dosyayı ("tkgm-parsel-sorgu-sonuc-") nereye kaydedildiğini buldum.

C:\Users\User\AppData\Local\Microsoft\Windows\Temporary Internet Files\......\.......\

klasörü altına kaydetmekte,

'-------------------------------------------------
'dosyayı açmak için
Application.Wait (Now + TimeValue("00:00:11"))
IE.document.all("[B]cphMaster_[color=red]btnKaydet[/B][/color]").Click

txt dosyayı klasör altına kaydetmek yerine; txt dosyayı direkt Açma yada Farklı Kaydet yapılamaz mı?

_btnKaydet yerine _btnAc veya _btnFarklıKaydet gibi....


teşekkürler,
iyi geceler...

Binden fazla mesajınız var 43 nolu mesajdaki kod aynen altdaki gibi kırmızı yerleri silin text dosyasını kaydetmeden açacaktır.


kod:

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
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
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys "{LEFT}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys "{LEFT}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True
'-------------------------------------------------

End If
IE.Quit: Set IE = Nothing
End With
[COLOR="Red"]Application.Wait (Now + TimeValue("00:00:02"))
Windows(yeni_dosya_adı).Activate
acik_olan_metin_dosyasini_ac1
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True[/COLOR]
MsgBox "işlem tamam"
End Sub

Diğer taraftan mesajlarımdan bir tanesinde webten veri almak baya zahmetli ve web siteleri güvenlik uygulamalarına geçiyor bu sitede resmi bir site ne zaman güvenlik sorgusu uygulayacağını bilemem ama mutlaka uygulayacaktır o zaman bu kodların hepsi boşuna gidecektir.

 

[tamer42]

Binden fazla mesajınız var 43 nolu mesajdaki kod aynen altdaki gibi kırmızı yerleri silin text dosyasını kaydetmeden açacaktır.


kod:

......................

End If
IE.Quit: Set IE = Nothing
End With
[COLOR="Red"]Application.Wait (Now + TimeValue("00:00:02"))
Windows(yeni_dosya_adı).Activate
acik_olan_metin_dosyasini_ac1
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True[/COLOR]
MsgBox "işlem tamam"
End Sub

Sn Halit size zahmet verdiğimin farkındayım.
Söylediklerinizi yaptım; yalnız ekli resimde belirtmek istediğim Bilgi çubuğunda Aç butonuna manuel olarak tıklanmadan TXT dosyası açılmıyor.

TXT dosyası C:\Users\User\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5\XZPHSFOO
klasörüne kaydedilmekte, ya buraya uzanıp; buradan açacağız, yada Farklı kaydet ile istediğimiz bir klasöre kayıt yapacağız.

üçüncü bir yolda direkt Aç işlemi, en kolay yöntem bu gibi....

iyi Çalışmalar.

 

[halit3]

Sn Halit size zahmet verdiğimin farkındayım.
Söylediklerinizi yaptım; yalnız ekli resimde belirtmek istediğim Bilgi çubuğunda Aç butonuna manuel olarak tıklanmadan TXT dosyası açılmıyor.

TXT dosyası C:\Users\User\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5\XZPHSFOO
klasörüne kaydedilmekte, ya buraya uzanıp; buradan açacağız, yada Farklı kaydet ile istediğimiz bir klasöre kayıt yapacağız.

üçüncü bir yolda direkt Aç işlemi, en kolay yöntem bu gibi....

iyi Çalışmalar.

Konudaki mesajları takip etmediğinizi düşünüyorum
34 nolu mesajdaki linkdeki işlemleri yaptınızmı ?

 

[tamer42]

Konudaki mesajları takip etmediğinizi düşünüyorum
34 nolu mesajdaki linkdeki işlemleri yaptınızmı ?

Sn Halit merhaba,

bu linkteki http://windows.microsoft.com/tr-tr/windows/internet-explorer-information-bar-faq#1TC=windows-7

işlemleri yaptım. Ekli ekran görüntüleri.....

Yalnız Karşıdan yüklemenin otomatik olarak sorulması seçeneğini bulamadım.

Özellikle ayarlanması gereken bölümler var mı?

teşekkürler,
Kolay gelsin.

 

[halit3]

ekli dosya resmi

 

[tamer42]

Merhaba,

Ayarlarda bir fark göremedim.....
Internet Explorer 11

iyi Çalışmalar.

 

[halit3]

Merhaba,

Ayarlarda bir fark göremedim.....
Internet Explorer 11

iyi Çalışmalar.

Söylediğinizden ne anlamalıyım bilmiyorum
Kısaca şunu söyleyim bilgi çubuğundaki dosya indirme ve açma vermiş olduğum linkdeki işlemleri yapıca dosya aç penceresi veya uyarısı ile ilgili bir nesne gelmiyor dolayısıyla web sitesindeki dosya açık hali ekrana geliyor.

Yukarıdaki mesajlarımın bir tanesinde görsel video vardı orada da görüldüğü gibi bilgi çubuğu uyarısı gelmemektedir.

 

[tamer42]

Söylediğinizden ne anlamalıyım bilmiyorum
Kısaca şunu söyleyim bilgi çubuğundaki dosya indirme ve açma vermiş olduğum linkdeki işlemleri yapıca dosya aç penceresi veya uyarısı ile ilgili bir nesne gelmiyor dolayısıyla web sitesindeki dosya açık hali ekrana geliyor.

Yukarıdaki mesajlarımın bir tanesinde görsel video vardı orada da görüldüğü gibi bilgi çubuğu uyarısı gelmemektedir.

Sn Halit merhaba,

"Internet Explorer 11" kullanıyorum, bunu demek istemiştim.
Ayrıca Internet Güvenlik ayarlarından bahsetmiştim.


yüklemiş olduğunuz görsel video' yu defalarca izledim. Video da görünen indirilen dosyanın Aç ve Kaydet işlemleri manuel yapılmakta (ekli ekran görüntüleri.....)
Otomatik yapılmaya dair duruma rastlayamadım.


Teşekkürler,

iyi çalışmalar.

 

[halit3]

Sn Halit merhaba,

"Internet Explorer 11" kullanıyorum, bunu demek istemiştim.
Ayrıca Internet Güvenlik ayarlarından bahsetmiştim.


yüklemiş olduğunuz görsel video' yu defalarca izledim. Video da görünen indirilen dosyanın Aç ve Kaydet işlemleri manuel yapılmakta (ekli ekran görüntüleri.....)
Otomatik yapılmaya dair duruma rastlayamadım.


Teşekkürler,

iyi çalışmalar.

Videonun 4. dakikasından sonraki kısımı iyi irdeleyiniz mausenin imleci sol tarafta ok işareti olarak bekliyor bu gösterdiğiniz resimlerdeki olayların hepsini makro yapıyor.

kodun bu kısmı

Application.Wait (Now + TimeValue("00:00:01"))
IE.document.all("cphMaster_btnKaydet").Click
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys "{LEFT}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys "{LEFT}", True
Application.Wait (Now + TimeValue("00:00:01"))
SendKeys ("{Enter}"), True

Web sitesindeki kordinat indir bölümünü otomatik olarak açıyor.

 

[halit3]

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]