Hallo Leute,

Ich habe in Excel eine Liste von Links zu Dokumenten auf einem firmeninternen Server. Diese Dokumente sind auf einem Share Point gespeichert werden aber auf diversen Seiten verlinkt. Durch neuere Versionen der Dokumente kann es passieren, dass ein Link nicht mehr richtig funktioniert, daher möchte ich gerne per VBA Abfrage meine URL-Liste überprüfen lassen und funktionsfähige Links in grün und kaputte Links rot einfärben.

Meine VBA-Kenntnisse sind stark eingerostet und habe mich durch das ganze Web gesucht und alles mögliche probiert.
Momentan ist der folgende Code in Verwendung. Jedoch funktioniert er nicht korrekt. Entweder werden alle Links als "ok" angezeigt, oder alle sind rot.
Auch nach verfälschen einiger zuvor "korrekter" Links zeigt mir das Makro die Links immer noch als okay an.
Jetzt gerade funktioniert es wieder nicht.
Zum Testen versuche ich "http://www.google.de" aber selbst der Link ist angeblich defekt.

Habt ihr einen neuen Vorschlag?

Liebe Grüße

Sub Link_Pruefen()
   Dim hypLink As Hyperlink
   Dim varFehler As Variant
   Dim AnzahlFalsch As Integer
   Dim LetzteZeile As Integer
       'Bestimmen der Letzten Zeile in Spalte B
       LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
       
       ActiveSheet.Range(Cells(9, 2), Cells(LetzteZeile, 2)).Interior.ColorIndex = 0
       
   For Each hypLink In ActiveSheet.Range(Cells(9, 2), Cells(LetzteZeile, 2)).Hyperlinks
       If TypeName(hypLink.Parent) = "Range" Then
           On Error Resume Next
           varFehler = Dir(hypLink.Address)
           If varFehler = "" Then
               varFehler = Err.Number
           Else
               varFehler = Dir(hypLink.Address)
           End If
           On Error GoTo 0
           If Not IsNumeric(varFehler) Then
               hypLink.Parent.Interior.ColorIndex = 4
           Else
               hypLink.Parent.Interior.ColorIndex = 3
               AnzahlFalsch = AnzahlFalsch + 1
           End If
       End If
   Next
   MsgBox AnzahlFalsch & " Verlinkungen sind fehlerhaft." & vbCrLf & vbCrLf & "Bitte beheben!",  _
   vbExclamation, "Defekte Links entdeckt!"
   End Sub