Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Per VBA : Erreichbarkeit von Hyperlinks überprüfen

Forumthread: Per VBA : Erreichbarkeit von Hyperlinks überprüfen

Per VBA : Erreichbarkeit von Hyperlinks überprüfen
14.04.2013 21:43:49
Hyperlinks
Hallo Leute,
ich möchte per VBA die zahlreiche Hyperlinks mit dem URL auf die Erreichbarkeit überprüfen.
NoNet hat selbe Frage hier https://www.herber.de/forum/archiv/1084to1088/t1084301.htm#1084301
gestellt. Er hat seine Lösung in einem anderen Thread https://www.herber.de/forum/messages/1086218.html
gepostet, der leider nicht mehr erreichbar ist.
ich habe eine Excel-Tabelle mit zahlreichen Hyperlinks ins WWW (diverse unterschiedliche URLs),  _
_
z.B. :
http://www.irgend-eine-seite.  _
_
com/forum/Beitrag4711.php
http://was-soll.das/?
http://www.meinebank. _
_
ru/konto/nepper/schlepper/Bauernfaenger.asp
http://www.abcxyz.de
etc.
Nun möchte ich per VBA überprüfen, welche URLs noch erreichbar sind und welche "tot" sind.
Leider fehlt mir der passende Ansatz dazu :-( - könnte mir jemand einen Tip geben ?
Was ich NICHT möchte : Hyperlink mit IE aufrufen und dann den Status des IE abfragen !
Der Code sollte browserunabhängig funktionieren (evtl. per API ?) und z.B. als FUNCTION einen   _
_
Returncode zurückgeben.
Zusätzliches Problem : Wenn ich z.B. http://www.irgend-eine-seite.com/forum/Beitrag4711.php
abfrage, diese Seite jedoch nicht mehr erreichbar ist und der Server dann automatisch auf http://www.irgend-eine-seite.com/default404.html
umleitet, wird zwar eine Seite angezeigt, aber nicht die zu überprüfende Seite - dieser Link  _
sollte dann auch als "tot" gemeldet werden.
Ich bin über jede konstruktive Hilfe dankbar,
Gruß NoNet
Hat jemand bitte eine Lösung für mich?
Danke vorab...
Gruß,
Selma

Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Per VBA : Erreichbarkeit von Hyperlinks überprüfen
14.04.2013 22:47:49
Hyperlinks
Hallo Selma,

Option Explicit
Public Function GetLinkStatus(ByVal strUrl As String) As Boolean
Dim objXMLHTTP As Object
If Not Left$(strUrl, 7) = "http://" Then strUrl = "http://" & strUrl
Set objXMLHTTP = CreateObject("Msxml2.XMLHTTP")
On Error Resume Next
objXMLHTTP.Open "GET", strUrl, False
objXMLHTTP.Send
GetLinkStatus = objXMLHTTP.Status = 200
Set objXMLHTTP = Nothing
On Error GoTo 0
End Function


Public Sub Linkcheck()
If GetLinkStatus("http://www.domain.com") Then
Call ERREICHBAR
Else
Call NICHTERREICHBAR
End If
End Sub

Greets

Anzeige
Link zum Archivthread
15.04.2013 00:53:13
Erich
Hi Selma,
den Link auf NoNets Beitrag im Archiv zu erraten ist doch nicht so schwer. :-)
https://www.herber.de/forum/archiv/1084to1088/t1086218.htm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Link zum Archivthread
15.04.2013 17:53:04
Selma
@Henner: Danke für den Code. Ich komme da nicht weiter. Was muss ich anstelle von Call ERREICHBAR und
Call NICHTERREICHBAR einsetzen?
Ich habe in Spalte D ab Zeile 2 (bis letzte benutzte Zelle der Spalte A) die Hyperlinks stehen.
Die nicht erreichbare Links sollen in rot eingefärbt werden.
@Erich: Danke für den Link :-)
Leider kann ich nicht viel damit anfangen. Daher die Bitte, ob Du mir helfen kannst.
Ich habe in Spalte D ab Zeile 2 (bis letzte benutzte Zelle der Spalte A) die Hyperlinks stehen.
Die nicht erreichbare Links sollen in rot eingefärbt werden.
Die Frage ist identisch, wie die von NoNet: https://www.herber.de/forum/archiv/1084to1088/t1086218.htm
Wie mache ich das?
Viele Grüße,
Selma

Anzeige
Erreichbarkeit von Hyperlinks
16.04.2013 01:55:19
Hyperlinks
Hi Selma,
das hier habe ich gefunden und ein wenig angepasst:

Option Explicit
' nach: URLs testen - von Josef Ehrensberger am 01.02.2011 16:35:45
' www.herber.de/forum/archiv/1196to1200/t1198467.htm#1198487
Sub CheckURL()
Dim rngBer As Range, rngC As Range, objHttpReq As Object
Set objHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Set rngBer = Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
For Each rngC In Cells(2, 4).Resize( _
Cells(Rows.Count, 1).End(xlUp).Row - 1)
If rngC.Text Like "htt" & "p://*" Then  ' wegen Codedarstellung im Forum
With objHttpReq
.Open "GET", rngC.Text
.Send
If .StatusText  "OK" Then rngC.Interior.Color = 255
'           rngC.Offset(0, 1) = .Status
'           rngC.Offset(0, 2) = .StatusText
End With
End If
Next rngC
Set objHttpReq = Nothing
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Erreichbarkeit von Hyperlinks
16.04.2013 16:01:23
Hyperlinks
Hallo Erich,
bei mir bleibt das Makro hier .Send stehen.
Gruß,
Selma

was passiert?
16.04.2013 16:48:53
Erich
Hi Selma,
gibt es eine Fehlermeldung? Oder die Sanduhr? Was geschieht?
Wie lautet die URL, bei der das passiert?
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: was passiert?
18.04.2013 12:19:07
Selma
Hallo Erich,
ich habe gesehen, dass im Code nur die Adressen geprüft werden, wenn diese entweder "htt" oder "p://*" enthalten.
Zum Testen habe bei einigen Links, die mit "www" beginnen, vorne noch "http" eingetragen.
Meldung:
Laufzeitfehler '-2147012889 (80072ee7)':
Der Servername oder die Serveradresse konnte nicht verarbeitet werden !!
Wenn ich es nur mit Internetadressen teste, die auch erreichbar sind, dann kommt keine Meldung.
Diese kommt nur dann, wenn eine Internetadresse nicht erreichbar ist.
Vielleicht lässt sich diese Meldung abfangen.
Die Adressen, die nicht erreichbar sind, sollen mit rote Füllfarbe dargestellt werden.
Es wäre schön, wenn der Code auch mit Adressen funktionieren würde, die mit "www" beginnen.
Viele Grüße,
Selma

Anzeige
Das geht auch
18.04.2013 12:56:28
Erich
Hi Selma,
"dass im Code nur die Adressen geprüft werden, wenn diese entweder "htt" oder "p://*" enthalten" ?
Stimmt nicht so ganz. Da geht es nicht um entweder - oder.
Da steht "htt" & "p://*" im Code, und "&" ist der Verkettungsoperator, also steht da nur
h ttp://*
(ohne das Leerzeichen hinter dem h, das habe ich hier nur eingefügt wegen der Darstellung hier im Forum)
Nur wegen dieser Darstellung hatte ich auch "htt" & "p://*" geschrieben.
Richtig ist, dass der Code nur URLs prüft, die mit dem http-Text beginnen.
Die Beispiele in deinem Eingangsbeitrag fingen ja auch alle damit an.
Hier eine Version, die nötigenfalls das http voranstellt.
An drei Stellen steht statt "http" der Text "h ttp" im Code,
da musst du jeweils das Leerzeichen nach dem h löschen:

Sub CheckURL()
Dim rngBer As Range, rngC As Range, oHttpReq As Object, strT As String
Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Set rngBer = Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
For Each rngC In Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
strT = rngC.Text
' falls nötig, vorn "h ttp://" ergänzen
If LCase$(Left$(strT, 7))  "h ttp://" Then strT = "h ttp://" & strT
With oHttpReq
.Open "GET", strT
.Send
If .StatusText  "OK" Then rngC.Interior.Color = 255
rngC.Offset(0, 1) = .Status                           ' zum Testen
rngC.Offset(0, 2) = .StatusText                       ' zum Testen
rngC.Offset(0, 3) = strT                              ' zum Testen
End With
Next rngC
Set oHttpReq = Nothing
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Das geht auch
18.04.2013 13:43:07
Selma
Hallo Erich,
ok, jetzt habe ich es mit "http://" verstanden :-)
Ich habe es getestet. Die Adressen, die erreichbar sind, funktionieren.
Die Adressen die nicht erreichbar sind, funktionieren nicht, es kommt nach wie vor die Meldung:
Laufzeitfehler '-2147012889 (80072ee7)':
Der Servername oder die Serveradresse konnte nicht verarbeitet werden !!

Gruß,
Selma

Anzeige
nur mit 'On Error ...'
18.04.2013 18:00:21
Erich
Hi Selma,
diese Laufzeitfehler habe ich nur mit einem "On Error Resume Next" wegbekommen.
Aber vielleicht reicht das ja aus. Probier mal
(das Leerzeichen im h t t p nicht vergessen ;-)

Option Explicit
Sub CheckURL2()
Dim rngBer As Range, rngC As Range, oHttpReq As Object
Dim strUrl As String, lngS As Long, strErg As String
Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Columns("E:G").ClearContents
Set rngBer = Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
On Error Resume Next
For Each rngC In rngBer
strUrl = rngC.Text
' falls nötig, vorn "h ttp://" ergänzen
If LCase$(Left$(strUrl, 7))  "h ttp://" Then strUrl = "h ttp://" & strUrl
lngS = 0
With oHttpReq
.Open "GET", strUrl
.Send
lngS = .Status
Select Case lngS
Case 200:   strErg = .StatusText
Case 404:   strErg = .StatusText
rngC.Interior.Color = 255
Case Else:  strErg = "Fehler"
rngC.Interior.Color = 255
End Select
rngC.Offset(0, 1) = lngS                        ' zum Testen
rngC.Offset(0, 2) = strErg                      ' zum Testen
rngC.Offset(0, 3) = strUrl                      ' zum Testen
End With
Next rngC
On Error GoTo 0
Set oHttpReq = Nothing
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: nur mit 'On Error ...'
18.04.2013 18:36:32
Selma
Hallo Erich,
jetzt funktioniert es :-)
Kann im Code die zu prüfende Zelle ausgeschlossen werden, wenn diese leer ist?
Momentan werden die leeren Zellen auch eingefärbt.
Viele Grüße,
Selma

auch das noch... ;-)
18.04.2013 20:03:14
Erich
Hi Selma,
klar, das geht:

Sub CheckURL2()
Dim rngBer As Range, rngC As Range, oHttpReq As Object
Dim sUrl As String, lngS As Long, strErg As String
Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Columns("E:G").ClearContents
Set rngBer = Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
On Error Resume Next
With oHttpReq
For Each rngC In rngBer
sUrl = rngC.Text
If Len(sUrl) > 4 Then ' mind. 5 Zeichen
' falls nötig, vorn "h ttp://" ergänzen
If LCase$(Left$(sUrl, 7))  "h ttp://" Then sUrl = "h ttp://" & sUrl
lngS = 0
.Open "GET", sUrl
.Send
lngS = .Status
Select Case lngS
Case 200:   strErg = .StatusText
Case 404:   strErg = .StatusText
rngC.Interior.Color = 255
Case Else:  strErg = "Fehler"
rngC.Interior.Color = 255
End Select
rngC.Offset(0, 1) = lngS                        ' zum Testen
rngC.Offset(0, 2) = strErg                      ' zum Testen
rngC.Offset(0, 3) = sUrl                        ' zum Testen
End If
Next rngC
End With
On Error GoTo 0
Set oHttpReq = Nothing
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: auch das noch... ;-)
18.04.2013 20:30:50
Selma
PERFEKT!!!
Vielen Dank!!!
Gruß,
Selma
;
Anzeige
Anzeige

Infobox / Tutorial

Erreichbarkeit von Hyperlinks in Excel mit VBA überprüfen


Schritt-für-Schritt-Anleitung

  1. Öffne deine Excel-Datei und drücke ALT + F11, um den VBA-Editor zu öffnen.

  2. Füge ein neues Modul hinzu:

    • Klicke mit der rechten Maustaste auf „VBAProject (deinDateiname.xlsx)“.
    • Wähle „Einfügen“ -> „Modul“.
  3. Füge den folgenden Code ein:

    Option Explicit
    Sub CheckURL()
       Dim rngBer As Range, rngC As Range, oHttpReq As Object
       Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
       Set rngBer = Cells(2, 4).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
       rngBer.Interior.Pattern = xlNone
       On Error Resume Next
       For Each rngC In rngBer
           If rngC.Text Like "http://" Then
               With oHttpReq
                   .Open "GET", rngC.Text
                   .Send
                   If .StatusText <> "OK" Then rngC.Interior.Color = 255
               End With
           End If
       Next rngC
       Set oHttpReq = Nothing
    End Sub
  4. Ändere die Zellreferenz (z.B. Cells(2, 4)) nach deinen Bedürfnissen, um die Spalte mit den Hyperlinks anzugeben.

  5. Führe das Makro aus, um die Links zu überprüfen. Die nicht erreichbaren Links werden in Rot eingefärbt.


Häufige Fehler und Lösungen

  • Laufzeitfehler '-2147012889 (80072ee7)': Dies tritt auf, wenn der Servername oder die Adresse nicht verarbeitet werden kann. Dies kann durch ungültige URLs verursacht werden. Stelle sicher, dass alle Hyperlinks korrekt formatiert sind.

  • Links werden nicht eingefärbt: Überprüfe, ob die Zellreferenz im Code korrekt ist und dass die URLs mit „http://“ beginnen.


Alternative Methoden

Eine alternative Methode zur Erreichbarkeitsprüfung von Links ist die Verwendung von Excel-Formeln und Webabfragen, jedoch ist dies weniger effektiv als die Verwendung von VBA, da es keine umfassende Statusprüfung anbietet. VBA ist flexibler und ermöglicht eine umfassendere Fehlerbehandlung.


Praktische Beispiele

Hier sind Beispiele für den VBA-Code zur Überprüfung der Erreichbarkeit:

  1. Einfaches Beispiel:

    Public Function GetLinkStatus(ByVal strUrl As String) As Boolean
       Dim objXMLHTTP As Object
       Set objXMLHTTP = CreateObject("Msxml2.XMLHTTP")
       On Error Resume Next
       objXMLHTTP.Open "GET", strUrl, False
       objXMLHTTP.Send
       GetLinkStatus = (objXMLHTTP.Status = 200)
       Set objXMLHTTP = Nothing
    End Function
  2. Erweiterte Fehlerbehandlung:

    On Error Resume Next
    ' ... Code zur Überprüfung ...
    If Err.Number <> 0 Then
       ' Fehlerbehandlung
    End If
    On Error GoTo 0

Tipps für Profis

  • Verwende On Error Resume Next vorsichtig, um Laufzeitfehler zu vermeiden. Dies gibt dir die Möglichkeit, mit Fehlern umzugehen, ohne dass das Makro stoppt.
  • Teste den Code mit verschiedenen URL-Formaten (mit und ohne „www“), um sicherzustellen, dass alle Links überprüft werden.
  • Optimiere den Code, indem du die Anzahl der HTTP-Anfragen minimierst, um die Ausführungsgeschwindigkeit zu erhöhen.

FAQ: Häufige Fragen

1. Wie kann ich die Hyperlinks in einer anderen Spalte überprüfen?
Du kannst die Zellreferenz in Set rngBer = Cells(2, 4) entsprechend anpassen.

2. Kann ich auch andere Statuscodes überprüfen?
Ja, passe die Select Case-Anweisung im Code an, um zusätzliche Statuscodes zu berücksichtigen.

3. Wie kann ich die Formatierung für nicht erreichbare Links ändern?
Ändere den Wert rngC.Interior.Color = 255 in die gewünschte Farbnummer (z.B. 65535 für Gelb).

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige