Links aus Internetseite auslesen

Hallo,

ich war in der Forumssuche auf der Suche nach einem Makro, welches mir alle Links aus einer Internetseite auflistet und bin auf dieses hier gestoßen und war selbst verblüfft dass es unter Windows 11 mit allen Updates immer noch funktioniert. Ebenfalls fand ich super, was das Makro in Spalte B schreibt, eigentlich hätte ich gedacht ich müsste diese Infos von Hand in Excel kopieren

Aber nun zu meiner Frage.
Gibt es auch eine Möglichkeit in Tabelle2 Spalte A eine Liste mit Internetseiten vorzugeben, die nacheinander abgearbeitet werden sollen, (und die gefundenen Links alle nacheinander aufgelistet) anstatt eine einzige URL ins Makro einzutragen?

Danke für eure Hilfe
Christian

Option Explicit





Public Sub test()

Dim objIE As Object

Dim objLinks As Object

Dim objLink As Object

Dim lngCount As Long

Set objIE = CreateObject("InternetExplorer.Application")

With objIE

    .navigate "https://"

    Do While .busy

        Do While .busy

            DoEvents

        Loop

    Loop

    .Visible = True

    Set objLinks = .Document.Links

    For Each objLink In objLinks

        lngCount = lngCount + 1

        Cells(lngCount, 1) = objLink.href

        Cells(lngCount, 2) = "'" & objLink.outertext

    Next

    .Quit

End With

Set objIE = Nothing

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Liste_lesen() Dim Adresse Dim Erg With Worksheets("Tabelle2") 'Schleife über die Vorgaben For Each Adresse In Range(.Range("A1"), .Range("A99999").End(xlUp)) 'Schleife über die Rückgabe For Each Erg In LinksListe(Adresse.Value) With .Range("D99999").End(xlUp) 'Herausgabe in Spalte D, E, F .Offset(1, 0).Value = Adresse.Value 'die Quelle .Offset(1, 1).Value = Erg.Href 'der Link .Offset(1, 2).Value = Erg.OuterText 'der Text End With Next Next End With End Sub Public Function LinksListe(ByVal Adresse As String) With CreateObject("InternetExplorer.Application") .navigate Adresse Do While .busy DoEvents Loop .Visible = True Set LinksListe = .Document.Links .Quit End With End Function

Public Sub test() Dim objIE As Object Dim objLinks As Object Dim objLink As Object Dim lngCount As Long Dim lloRow As Long, lshTab2 As Worksheet Set lshTab2 = Sheets("Tabelle2") For lloRow = 1 To lshTab2.Cells(lshTab2.Rows.Count, 1).End(xlUp).Row Set objIE = CreateObject("InternetExplorer.Application") With objIE .navigate lshTab2.Range("A" & lloRow).Hyperlinks(1).Address Do While .busy Do While .busy DoEvents Loop Loop .Visible = False Set objLinks = .Document.Links For Each objLink In objLinks lngCount = lngCount + 1 lshTab2.Cells(lngCount, 2) = objLink.href lshTab2.Cells(lngCount, 3) = "'" & objLink.outertext Next .Quit End With Next Set objIE = Nothing Set lshTab2 = Nothing End Sub

let LS = Excel.CurrentWorkbook () {[Name = "Tabelle1"]} [Content], GT = Table.TransformColumnTypes (LS, {{"Spalte1", type text}}), RV = Table.ReplaceValue(GT,"""","",Replacer.ReplaceText,{"Spalte1"}), HbS = Table.AddColumn (RV, "Link öffnen", each Web.Page ([Spalte1])) in HbS

Hallo Thorsten,

sorry dass ich mich vorhin nicht bedankt habe, ich hoffe du siehst es mir nach dass ich es erst jetzt tue.

Ich bekomme leider die Meldung "Index außerhalb des gültigen Bereichs". Ich habe auch eine Vermutung woran es liegt.
In Spalte A stehen bei mir mur die URL als Text. Es ist kein Hyperlink mit der URL hinterlegt. Hinterlege ich diesen funktioniert es. Aber das bei 800 Adressen händisch zu hinterlegen, ist ein immenser Aufwand.
LÄsst sich da nicht seitens des Makros noch eine Anpassung vornehmen?

Hier noch eine Datei wie ich es meine zum hoffentlich besseren Verständnis. Wenn du da Einzelschritte ausführst, siehst du dass der Link in A1 abgearbeitet wird und dann bei A2 in der Zeile .navigate lshTab2.Range("A" & lloRow).Hyperlinks(1).Address der Fehler kommt, ich vermute mal weil in A2 keine Hyperlink Adresse hinterlegt ist.

Bist du bitte so nett und passt dein Makro nochmal dahingehend an?

Gruß
Christian

https://www.herber.de/bbs/user/164946.xlsm

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Links aus Internetseite auslesen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread