Gruppe
Allgemein
Problem
Die Hyperlinks in A sollen auf ihre Gültigkeit geprüft werden. Es muss eine Internetverbindung bestehen.
StandardModule: Modul1
Sub CheckHyperlinks()
Dim itc As Inet
Dim ws As Worksheet
Dim hyp As Hyperlink
Set itc = New Inet
With itc
.Protocol = icHTTP
.RequestTimeout = 5
End With
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
For Each hyp In ws.Hyperlinks
If Len(itc.OpenURL(hyp.Address, icString)) Then
hyp.Parent.Interior.ColorIndex = _
xlColorIndexNone
Else
hyp.Parent.Interior.ColorIndex = 3
End If
Next hyp
Next ws
On Error GoTo 0
Set itc = Nothing
End Sub