Thema Datum  Von Nutzer Rating
Antwort
Rot Web-Links per VBA testen
16.08.2016 11:35:49 Lars
NotSolved
16.08.2016 14:18:38 Gast11399
NotSolved

Ansicht des Beitrags:
Von:
Lars
Datum:
16.08.2016 11:35:49
Views:
1011
Rating: Antwort:
  Ja
Thema:
Web-Links per VBA testen

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Web-Links per VBA testen
16.08.2016 11:35:49 Lars
NotSolved
16.08.2016 14:18:38 Gast11399
NotSolved