• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Web Sayfasında İçerik Kontrolü

Katılım
20 Haziran 2006
Mesajlar
55
Excel de bir hücredeki içeriği web sayfaları içerisinde aşağıdaki kod ile kontrol edebilmekte, ilgili sitede var ise Var - Yok şeklinde bir sütuna yazdırabilmektediyiz.


Fakat adreslerden biri hatalı veya zamanında açılmaz ise makro "W.Send" satırında hata veriyor. Burada hata vermeden çalışmaya devam etmesini nasıl sağlarız.?



Sub WebSayfasindaAraR()
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


bas = Now
Range("b2:B2").ClearContents
For i = 2 To [a65536].End(3).Row

URL = Cells(i, 1)


W.Open "GET", URL, False
W.Send

Temp = W.ResponseText
Temp = ConvertTurkish(Temp)

For y = 2 To [b1].Column
Ara = Cells(1, y)
If InStr(Temp, Ara) <> 0 Then
Cells(i, y) = " Var"

Else
Cells(i, y) = " 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, 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
 
Üst