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
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