Web sayfasi icerik kontrolü

[sipkam]

Merhabalar



Excelde A1 hücremizde "Grafikler" metni var



A2= http://www.google.com.tr

A3= http://www.hurriyet.com.tr

A4= http://www.e-kolay.net değerleri var...



Amacımız excel ile A1 hücresindeki metnin A2 websayfasinda olup olmadığı kontrol etmek. Eğer var ise B2 hücresi "Var" yazdırmak, eğer yok ise "Yok" yazdırmak.



Aynı şekilde bunu sıra ile A3,A4 ... deki satırlar için yaptırmak...



Bu tarz bir icerik kontrolünü php scriptte yapabilmiştik.. Excelde bu yapılabilirmi?

 

[veyselemre]

Ekteki örneği inceleyin..

 

[Haluk]

VBA editöründe Tools>References kısmında Referanslarınız eksik veya hatalı olabilir, Referanslarda Missing yazan varsa o referans geçerli değildir. WinHttp ile Sorgulamak için en azından Microsoft WinHTTP Services, Version.... yüklenmiş olması gerekir.

Eklenen referanslar, değişik makinalarda bu tip sorunlar çıkartabiliyor.

Referanslarda kullanılan bu tip değişkenler yerine aşağıdaki gibi bir yöntem izlenebilir. Böylece, dosyaya referans eklemeye gerek kalmaz.

        Dim W As Object
        On Error Resume Next
            Set W = CreateObject("winhttp.winhttprequest.5")
            If Err.Number <> 0 Then
                Set W = CreateObject("winhttp.winhttprequest.5.1")
            End If
        On Error GoTo 0

Şurası da bir gerçek ki, winhttp yöntemi çok daha hızlı çalışıyor.

Teşekkürler, Veysel bey.

 

[Haluk]

Sayın veyselemre,

İzninizle, bir ilave daha yapmak istedim.

Dosyanızdaki kodlara bir fonksiyon ilave ederek, WinHTTP kullanımındaki Türkçe karakter problemini şöyle çözmeye çalıştım.

Böylece, referans ekleme ve Türkçe karakter problemi çözülmüş gibi görünüyor.

Tam olarak test etmedim ama, sizin örnek dosyanızdaki verilerle bir problem çıkmadı.

WinHTTP kullanımı hakkındaki örneğiniz için, tekrar teşekkürler.

Sub WebSayfasindaAraR()
    Dim W As Object
    bas = Now
    Range("b2:IV" & [a65536].End(3).Row).ClearContents
    For i = 2 To [a65536].End(3).Row
        
        URL = Cells(i, 1)
        On Error Resume Next
            Set W = CreateObject("winhttp.winhttprequest.5")
            If Err.Number <> 0 Then
                Set W = CreateObject("winhttp.winhttprequest.5.1")
            End If
        On Error GoTo 0
        
        W.Open "GET", URL, False
        W.Send
        
        Temp = W.ResponseText
        Temp = ConvertTurkish(Temp)
        
        For y = 2 To [b1].End(xlToRight).Column
            Ara = Cells(1, y)
                If InStr(Temp, Ara) <> 0 Then
                    Cells(i, y) = Ara & " Var"
                        Else
                    Cells(i, y) = Ara & " Yok"
                End If
        Next y
    Next i
    
    Set W = Nothing
    MsgBox "İşlem " & Format(Now - bas, "ss") & " Saniye Sürdü..."
End Sub
'
Function ConvertTurkish(strVal)
    ConvertTurkish = Replace(Replace(Replace(Replace _
                    (Replace(Replace(Replace(Replace _
                    (Replace(Replace(Replace(Replace _
                    (strVal, "Ãœ", "Ü"), "Åž", "Ş"), _
                    "Äž", "Ğ"), "Ç", "Ç"), "Ä°", "İ"), _
                    "Ö", "Ö"), "ü", "ü"), "ÅŸ", "ş"), _
                    "ÄŸ", "ğ"), "ç", "ç"), "ı", "ı"), _
                    "ö", "ö")
End Function

 

[Haluk]

Eğer bu kodları çalıştırdığınız bilgisayar WinXP gibi bir işletim sistemine sahip değilse, gerekli Winhttp.dll dinamik kütüphanesi bilgisayarda bulunmayabilir.

Bu durumda, aşağıdaki linkten sözkonusu Winhttp.dll dosyasını indirip, bunu sistem klasörüne yerleştirip, regsvr32.exe dosyası ikonunun üzerine sürükleyip, bırakarak windows'a register ettikten sonra, kodları tekrar deneyebilirsiniz.

Winhttp.dll dosyasının temin edilebileceği link:

http://www.dll-files.com/dllindex/dll-files.shtml?winhttp

 

[Haluk]

Bir şey daha belirtmek istedim;

Yukarıdaki mesajımda belirttiğim ConvertTurkish fonksiyonu ile, evdeki WinXP işletim sisteminde Türkçe karakterlerde problem çıkmamıştı.

İş yerimdeki Win2000 ile kodları denediğimde ise, ilk önce Winhttp.dll olmadığı için problem çıkmıştı. Bunu, yukarıdaki en son mesajımda belirttiğim gibi ilgili DLL dosyasını bulup, yükleyince kod çalışmıştı ama, Türkçe karakterlerde yine problem vardı.

Son olarak, bahsettiğim fonksiyonu aşağıdaki gibi revize ettim ve şimdi her şey yolunda gibi görünüyor... :mrgreen:

Function ConvertTurkish(strVal)
    ConvertTurkish = Replace(Replace(Replace(Replace _
                    (Replace(Replace(Replace(Replace _
                    (Replace(Replace(Replace(Replace _
                    (strVal, ChrW$(220), "Ü"), ChrW$(222), "Ş"), _
                    ChrW$(208), "Ğ"), ChrW$(199), "Ç"), ChrW$(221), "İ"), _
                    ChrW$(214), "Ö"), ChrW$(252), "ü"), ChrW$(254), "ş"), _
                    ChrW$(240), "ğ"), ChrW$(231), "ç"), ChrW$(253), "ı"), _
                    ChrW$(246), "ö")
End Function

 

[sipkam]

Teşekkürler Haluk Bey,


elinize sağlık...

 

[sipkam]

Haluk/Veyselemre Bey,

Eğer kontrol ettiği url'den cevap alamaz ise veya bağlanamaz ise W.Sent satırında "Run time error -214701894 The operation timet out" hatası veriyor. Bunu nasıl engelleriz? Veya 100 satır içinde arada bos satır var ise buradada hata vermemeli? burayı boş geçmeli..

Birde Var yazısını yeşil, Yok yazısını nasıl kırmızı yazdırırız..?

 

[sipkam]

Haluk Bey,


bu icerik kontrolünde kontrol edilen url hatalı ve bağlanmada zaman aşımı olursa hata veriyor.. bu hatayı vermeden nasıl devam ettiririz...

Birde Var yazısını yeşil, Yok yazısını nasıl kırmızı yazdırırız..?

Şimdiden teşekkürler...