Verfügbarkeit von Web-Links mit VBA prüfen

Forumthread: Verfügbarkeit von Web-Links mit VBA prüfen

15.08.2016 21:16:38

Web-Links

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 "https://www.google.de" aber selbst der Link ist angeblich defekt.
Habt ihr einen neuen Vorschlag?

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Verfügbarkeit von Web-Links mit VBA prüfen

15.08.2016 21:22:58

Web-Links

Hallo,
vor kurzem habe ich einen Code geschrieben, der die Existenz von Webseiten prüft. Vielleicht ist es für dein thema übertragbar.


Sub Webseite_pruefen()
Dim Hy As Hyperlink
anfang = Timer
With CreateObject("MSXML2.XMLHTTP")
For Each Hy In ActiveSheet.Hyperlinks
If IsEmpty(Range(Hy.Range.Address).Offset(0, 1)) Then
i = i + 1
If i > 20 Then Exit For
Application.Goto Range(Hy.Range.Address)
On Error Resume Next
'Debug.Print Hy.Address, Hy.Range.Address
.Open "get", Hy.Address, False
.send
If Err.Number  0 Then
Range(Hy.Range.Address).Offset(0, 1) = Err.Number & ", " & Err.Description
Else
Range(Hy.Range.Address).Offset(0, 1) = "OK"
End If
On Error GoTo 0
End If
Next Hy
End With
Cells(1, 5) = Timer - anfang
End Sub

mfg

AW: Verfügbarkeit von Web-Links mit VBA prüfen

15.08.2016 21:30:49

Web-Links

Funktioniert das dann auch mit Dokumenten? PDF, Docx etc. und nicht reinen Webseiten?

AW: Verfügbarkeit von Web-Links mit VBA prüfen

16.08.2016 10:16:16

Web-Links

Habe den Code heute mal eingebaut und für mein Problem etwas angepasst, sodass die Links je nach Zustand farbig hinterlegt werden.
Allerdings wenn ich das ganze auf Richtigkeit teste und einige Links verfälsche, so dass sie niemals funktionieren könnten, zeigt er die Links dennoch als funktionsfähig an.
Irgendwelche Vorschläge? Vielen Dank schon im voraus.

 Sub Webseite_pruefen()
Dim Hy As Hyperlink
Dim LetzteZeile As Integer
'Bestimmen der Letzten Zeile in Spalte B
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
anfang = Timer
With CreateObject("MSXML2.XMLHTTP")
For Each Hy In ActiveSheet.Range(Cells(9, 2), Cells(LetzteZeile, 2)).Hyperlinks
Application.Goto Range(Hy.Range.Address)
On Error Resume Next
'Debug.Print Hy.Address, Hy.Range.Address
.Open "get", Hy.Address, False
.send
If Err.Number  0 Then
Range(Hy.Range.Address).Interior.ColorIndex = 3
Else
Range(Hy.Range.Address).Interior.ColorIndex = 4
End If
On Error GoTo 0
Next Hy
End With
Cells(1, 5) = Timer - anfang
End Sub

Infobox / Tutorial

Verfügbarkeit von Web-Links in Excel mit VBA prüfen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Um die Verfügbarkeit von Web-Links in Excel zu prüfen, kannst du den folgenden VBA-Code verwenden. Dieser Code überprüft die Links in einer bestimmten Spalte und färbt sie je nach Verfügbarkeit ein.

Öffne Excel und lade die Arbeitsmappe, die die Links enthält.
Öffne den VBA-Editor (drücke ALT + F11).
Füge ein neues Modul hinzu:
- Klicke mit der rechten Maustaste auf "VBAProject (DeineDatei.xlsx)".
- Wähle Einfügen > Modul.
Kopiere den folgenden Code in das Modul:

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 ' Grün für funktionsfähige Links
            Else
                hypLink.Parent.Interior.ColorIndex = 3 ' Rot für defekte Links
                AnzahlFalsch = AnzahlFalsch + 1
            End If
        End If
    Next

    MsgBox AnzahlFalsch & " Verlinkungen sind fehlerhaft." & vbCrLf & vbCrLf & "Bitte beheben!", _
    vbExclamation, "Defekte Links entdeckt!"
End Sub

Schließe den VBA-Editor und gehe zurück zu Excel.
Führe das Makro aus (drücke ALT + F8, wähle Link_Pruefen und klicke auf Ausführen).

Häufige Fehler und Lösungen

Alle Links werden als "OK" angezeigt: Überprüfe, ob die Links korrekt in der Tabelle eingetragen sind. Manchmal können unsichtbare Zeichen oder Leerstellen Probleme verursachen.
Links werden trotz absichtlich defekter URLs als funktionsfähig angezeigt: Stelle sicher, dass du die richtige Methode zum Prüfen der Links verwendest. Möglicherweise musst du die URL mit MSXML2.XMLHTTP anstelle von Dir prüfen.
VBA gibt eine Fehlermeldung aus: Überprüfe, ob die Internetverbindung aktiv ist und ob die Links tatsächlich erreichbar sind.

Alternative Methoden

Eine alternative Methode zur Überprüfung von Links ist die Verwendung des MSXML2.XMLHTTP-Objekts. Hier ist ein Beispielcode:

Sub Webseite_pruefen()
    Dim Hy As Hyperlink
    Dim LetzteZeile As Integer
    LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    Dim anfang As Double
    anfang = Timer

    With CreateObject("MSXML2.XMLHTTP")
        For Each Hy In ActiveSheet.Range(Cells(9, 2), Cells(LetzteZeile, 2)).Hyperlinks
            On Error Resume Next
            .Open "GET", Hy.Address, False
            .send
            If Err.Number <> 0 Then
                Range(Hy.Range.Address).Interior.ColorIndex = 3 ' Rot für defekte Links
            Else
                Range(Hy.Range.Address).Interior.ColorIndex = 4 ' Grün für funktionsfähige Links
            End If
            On Error GoTo 0
        Next Hy
    End With
    Cells(1, 5) = Timer - anfang
End Sub

Praktische Beispiele

Überprüfung von Webseiten: Du kannst diesen Code verwenden, um die Verfügbarkeit von Webseiten zu prüfen, z.B. https://www.example.com.
Überprüfung von Dokumenten: Der Code kann auch verwendet werden, um Links zu Dokumenten wie PDF oder DOCX zu prüfen, solange die Links korrekt formatiert sind.

Tipps für Profis

Nutze Application.ScreenUpdating = False, um das Bildschirmflackern während der Ausführung des Makros zu reduzieren.
Füge Error-Handling hinzu, um spezifische Fehlermeldungen auszugeben, wenn ein Link nicht erreichbar ist.
Teste deine Makros in einer sicheren Umgebung, bevor du sie auf wichtige Daten anwendest.

FAQ: Häufige Fragen

1. Funktioniert das Prüfen von Links in Excel auch für Dokumente?
Ja, du kannst auch Links zu Dokumenten wie PDF oder DOCX prüfen, solange die Links korrekt sind.

2. Was kann ich tun, wenn mein Makro nicht funktioniert?
Überprüfe den Code auf Syntaxfehler und stelle sicher, dass alle Links korrekt formatiert sind. Teste auch die Internetverbindung.

3. Gibt es eine Möglichkeit, Links automatisch zu aktualisieren?
Ja, du kannst VBA nutzen, um Links in deiner Excel-Tabelle automatisch zu aktualisieren, sobald sie geändert werden.

Beliebteste Forumthreads (12 Monate)

Verfügbarkeit von Web-Links mit VBA prüfen

Forumthread: Verfügbarkeit von Web-Links mit VBA prüfen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Verfügbarkeit von Web-Links in Excel mit VBA prüfen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread