Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1408to1412
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

Hyperlink prüfen und ändern über Makro

Hyperlink prüfen und ändern über Makro
12.02.2015 10:18:53
Dirk
Guten Tag zusammen,
hier mein Problem:
Ich habe ein Sheet mit einigen hundert Dateinamen und Hyperlinks zu Wikipedia. Die Hyperlinks werden über eine Funktion generiert:
=HYPERLINK(("http://de.wikipedia.org/C2wiki/"&(LINKS(A2;LÄNGE(A2)-4)));LINKS(A8;LÄNGE(A2)-4))
Damit soll direkt auf den Wikipedia-Artikel verlinkt werden.
Nun brauche ich ein Makro, das den Hyperlink überprüft und bei der Rückgabe von 404 (oder 200) auf die Wikipedia-Suche verlinkt und in die Zelle schreibt:
=HYPERLINK(("http://de.wikipedia.org/w/index.php?title=Spezial%3ASuche&profile=default&search="&(LINKS(A2; LÄNGE(A2)-4))&"&fulltext=Search");LINKS(A2;LÄNGE(A2)-4)
Ich habe schon einige Beispiele gegoogelt und ausprobiert, aber so ganz verstehe ich es nicht und selbst Funktionen, die nur richtig oder falsch ausgeben, funktionieren nicht.
Für Hilfe bin ich sehr dankbar.

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink prüfen und ändern über Makro
12.02.2015 12:33:30
Ralf
Hallo,
zuallererst benötigen die Helfenden eine Beispiel-Datei. Wer soll sich das nachbauen?
Wenn du Beispiele gefunden haben und grundsätzlich funktioniert haben, baue eines davon ein.
Es wird bestimmt mit createobject gearbeitet. Setze nach diesem Code ein STOP in den Code und überprüfe im Lokal-Fenster, was sich bei diesem Objekt tut. Mit F8 kannst du den Code zeilenweise abarbeiten. Im Lokal-Fenster kann man wunderbar verfolgen, was Variablen und Objekte für Eigenschaften und Werte haben.
Bei einem Error 404 kannst du schauen, welche Eigenschaft du benutzen musst.
Gruß
Ralf

Anzeige
AW: Hyperlink prüfen und ändern über Makro
12.02.2015 13:49:30
Dirk
Ich habe mal eine Beispieldatei (https://www.herber.de/bbs/user/95715.xlsx) beigefügt mit einem der Makros, die nicht funktionieren, vielleicht auch schon von mir verbastelt wurde.
In der Datei sind alle Möglichkeiten vorhanden. Zeile 2 und 3 funktionieren, Zeile 4 nicht und Zeile 5 ist die Syntax, auf die geändert werden soll, wenn der Link auf 404 läuft.

kein Makro oder Zeile 5, falsche Datei? owT
12.02.2015 20:03:20
Ralf

AW: kein Makro oder Zeile 5, falsche Datei? owT
13.02.2015 15:40:07
Dirk
Oops, da habe ich die falsche Datei erwischt. Hier die richtige: https://www.herber.de/bbs/user/95745.xlsm
Ich glaube, das größte Problem ist wohl, das ich die Funktion "Hyperlink" benutze, habe ich anhand der herumsuchens festgestellt. Wie kann ich denn ein Makro schreiben, das mir die Links in die 3. Spalte schreibt? Da könnte die Prüfung doch direkt integriert werden...
Mir fehlt grad jegliche konstruktive Idee. Danke für die Hilfe.

Anzeige
AW: kein Makro oder Zeile 5, falsche Datei? owT
13.02.2015 18:57:55
Ralf
Hallo Dirk,
probiere das mal aus.
Hier gehts unter Excel 2003.
Error 404 kommt nicht.
Stattdessen lasse ich den Seitentext nach "Diese Seite existiert nicht" durchsuchen.
Gruß
Ralf
Option Explicit
Sub Hyperlinks_Setzen()
Dim Zelle As Range
Const URL = "http://de.wikipedia.org/wiki/"
Dim TXT As String
Dim objWeb As Object
Const FehlerText = "Diese Seite existiert nicht"
'On Error Resume Next
Set objWeb = CreateObject("InternetExplorer.Application")
objWeb.Visible = True 'wenn sub fertig auf false setzen
For Each Zelle In Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
Application.StatusBar = Zelle.Row & ". Zeile von " & ActiveSheet.UsedRange.Rows.Count
If Zelle  "" Then
Zelle.Select
TXT = Left(Zelle, InStrRev(Zelle, ".", -1, vbTextCompare) - 1)
objWeb.Navigate URL & TXT
While objWeb.Busy Or objWeb.ReadyState  4: DoEvents: Wend
If InStr(1, objWeb.document.body.innerText, FehlerText, vbTextCompare) Then
'            Stop
Zelle.Offset(, 2).Hyperlinks.Add Zelle.Offset(, 2), URL & "Spezial:Suche/" & TXT, ,  _
"Fehler", "Suche.."
Else
Zelle.Offset(, 2).Hyperlinks.Add Zelle.Offset(, 2), URL & TXT, "", TXT, TXT
End If
TXT = ""
End If
Next Zelle
objWeb.Quit
Set objWeb = Nothing
Application.StatusBar = False
On Error GoTo 0
End Sub

Anzeige
AW: kein Makro oder Zeile 5, falsche Datei? owT
13.02.2015 20:22:06
Dirk
Vielen Dank, Ralf, das funktioniert Super. Ich werde mich noch ein wenig damit befassen, aber es deckt wohl alles ab. Nun versuche ich mal, das zu verstehen :-) Danke!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige