Url Kontrol

[sarman61]

Merhaba;

Arkadaşlar excel'de a satırında olan url'le kodlu resimlerin açılıp açılmadığını açılıyorsa b satırına resmin mevcut olduğunu yazmasını istiyorum.Ekte'ki excel yapmak istediğimi anlattım yardımlar için şimdiden çok teşekkürler...

 

[Ömer]

Merhaba,

Öncelikle VBA ekranından Tools/References menüsünden "Microsoft WinHTTP Services, Version 5.1" seçeneğini bulup işaretleyiniz.

Daha sonra aşağıdaki kodları module kopyalayıp çalıştırın.

Private Sub TestLinks()
     
    Dim oLink  As Hyperlink
     
    For Each oLink In ActiveSheet.Hyperlinks
        If oLink.Address <> "" And InStr(oLink.Address, "mailto") = 0 Then
            If Not TestURL(oLink.Address) Then
                oLink.Range.Offset(0, 1) = "Yok"
            Else
                oLink.Range.Offset(0, 1) = "Var"
            End If
        End If
    Next
     
    Set oLink = Nothing
     
End Sub
 
Private Function TestURL(strURL As String) As Boolean
     
    Dim oURL As New WinHttpRequest
     
    On Error GoTo TestURL_Err
     
    With oURL
        .Open "GET", strURL, False
        .Send
        TestURL = (.Status = 200)
    End With
     
TestURL_Err:
     
    Set oURL = Nothing
    
End Function

Not: Kodlar alıntı olup orjinal mesajı aşağıdaki linkten görebilirsiniz.

http://www.ozgrid.com/forum/showthread.php?t=151332

.