Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1188to1192
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hyperlinks prüf-Programm gesucht

Hyperlinks prüf-Programm gesucht
Pascal
Guten Tag miteinander
Ich brauche mal wieder (einmal mehr !) Eure Profi-Hilfe
Und zwar geht’s diesmal um folgendes Problem / Frage:
In einer Excel-Arbeitsmappe hab ich total 116 Tabellenblätter.
Auf diesen sind diverse Datensätze und auch unzählige Hyperlinks (verstreut über die jeweiligen Tabellenblätter und Zellen) abgelegt und gespeichert.
Die einzelnen Hyperlinks (diese liegen nicht immer in der selben Zelle oder Spalte) führen teilweise ins Internet, andere ins Firmen-Intranet und wieder andere in die
Firmen-Dokumentenablage von Sharepoint.
Leider ändert sich das Ziel eines Hyperlinks oftmals (weil z.B. ein Dokument in Sharepoint gelöscht oder verschoben wird, oder weil eine Internet-Seite gezügelt wird etc…)
Ich suche nun nach einer VBA-Makro-Lösung die folgendes tut :
- Alle Hyperlinks der ganzen Arbeitsmappe und aller Tabellenblätter im Hintergrund kurz öffnet und mir irgendwo (kann auch ein Textfile sein) protokolliert, ob der Hyperlink noch funktioniert oder nicht.
Gibt es irgendsowas ?
Währe Super wenn Ihr mir da helfen könnt.
Im voraus herzlichen Dank !

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Hyperlinks prüf-Programm gesucht
13.12.2010 12:21:32
ransi
HAllo
Sind das "echte Links" oder werden die mittels Formel =HYPERLINK() erzeugt ?
ransi
AW: Hyperlinks prüf-Programm gesucht
13.12.2010 12:59:31
ransi
Hallo
Versuch mal sowas:
Option Explicit


Public Sub machs()
    Dim SH As Object
    Dim HL As Hyperlink
    For Each SH In ThisWorkbook.Sheets
        For Each HL In SH.Hyperlinks
            MsgBox HL.Address & vbCrLf & (CheckLink(HL.Address) = 200)
        Next
    Next
End Sub


Public Function CheckLink(ByVal strUrl As String) As Long
    'http://www.office-loesung.de/ftopic244414_0_0_asc.php
    Dim objHttp As Object
    If Not Left(strUrl, 7) = "http://" Then strUrl = "http://" & strUrl
    Set objHttp = CreateObject("Msxml2.XMLHTTP")
    On Error Resume Next
    objHttp.Open "GET", strUrl, False
    objHttp.Send
    CheckLink = objHttp.Status
    Set objHttp = Nothing
    On Error GoTo 0
End Function



ransi
Anzeige
AW: Hyperlinks prüf-Programm gesucht
13.12.2010 13:47:31
Pascal
Guten Tag Ransi
Vorerst mal VIELEN VIELEN VIELEN HERZLICHEN DANK für diesen Lösungsansatz !
ich denke ... darauf lässt sich bauen ! :-)
nur ... gäbe es evt. eine Möglichkeit... statt der MsgBoxes, die Prüfergebnisse inkl. Linkadresse und Prüfergebnis - in ein File zu schreiben oder auf einem leeren Tabellenblatt aufzulisten ?
AW: Hyperlinks prüf-Programm gesucht
13.12.2010 19:40:51
ransi
Hallo
in ein File zu schreiben oder auf einem leeren Tabellenblatt aufzulisten ?Sorry, dachte nicht das das ein PRoblem werden könnte.
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit




Public Sub machs()
    Dim SH As Object
    Dim shLinkList As Worksheet
    Dim L As Long
    Dim HL As Hyperlink
    Set shLinkList = Worksheets.Add(, Sheets(Sheets.Count))
    For Each SH In ThisWorkbook.Sheets
        If Not SH Is shLinkList Then
            For Each HL In SH.Hyperlinks
                L = L + 1
                shLinkList.Cells(L, 1) = SH.Name
                If TypeOf HL.Parent Is Range Then
                    shLinkList.Cells(L, 2) = HL.Parent.Address
                    Else:
                    shLinkList.Cells(L, 2) = HL.Parent.Name
                End If
                shLinkList.Cells(L, 3) = HL.Address
                shLinkList.Cells(L, 4) = (CheckLink(HL.Address) = 200)
            Next
        End If
    Next
End Sub



Public Function CheckLink(ByVal strUrl As String) As Long
    'http://www.office-loesung.de/ftopic244414_0_0_asc.php
    Dim objHttp As Object
    If Not Left(strUrl, 7) = "http://" Then strUrl = "http://" & strUrl
    Set objHttp = CreateObject("Msxml2.XMLHTTP")
    On Error Resume Next
    objHttp.Open "GET", strUrl, False
    objHttp.Send
    CheckLink = objHttp.Status
    Set objHttp = Nothing
    On Error GoTo 0
End Function


ransi
Anzeige
AW: Hyperlinks prüf-Programm gesucht
13.12.2010 20:18:11
Pascal
Hi Again
HERZLICHEN Dank für Deine grossartige Hilfe !
ich werde diesen Code gleich kommenden Mittwoch testen (bin bis dahin leider nicht mehr am PC und ausser Hause)
Feedback folgt selbstverständlich dann !
AW: Hyperlinks prüf-Programm gesucht
15.12.2010 09:03:24
Pascal
Hallo allerseits !
Ich glaube das Makro entspricht nun genau dem was ich suchte :-)
HERZLICHEN DANK FÜR DIE SUPER-HILFE !!!!!
AW: Hyperlinks prüf-Programm gesucht
15.12.2010 09:47:02
Pascal
... doch noch etwas das nicht korrekt läuft und mir vielleicht jemand noch helfen kann:
In der Arbeitsmappe in welcher diese Links geprüft werden sollen gibt es u.a. auch links auf andere Stellen innerhalb der Arbeitsmappen selber.
also sozusagen Sprungmarken oder Textmarken. Diese werden auch als Fehler ausgegeben nur weil diese nicht mit http:// oder dergleichen beginnen.
kann man also den Code irgendwie anpassen, dass Arbeitsmappeninterne Hyperlinsk nicht als Fehler ausgegeben werden ?
HERZLICHEN DANK !!!!
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige