Mehrseitige Webseite auslesen mit Hyperlinks
Beverly
ich habe folgende Aufgabe: aus einer Webseite, bestehend aus mehreren (45) Unterseiten, sollen die Inhalte aller Unterseiten ausgelesen werden. Ich habe das realisiert, indem ich in einer Schleife mehrere Webabfragen tätige. Der Code sieht so aus (ist mit dem Makrorekorder aufgezeichnet und dann in eine Schleife umgewandelt):
Sub WebseitenAuslesen()
Dim intZaehler As Integer
Dim lngZeile As Long
intZaehler = 1
lngZeile = 35
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://portal.bvl.bund.de/psm/jsp/ListeMain.jsp?page=1&ts=1343843509938" _
, Destination:=Range("$A$1"))
.Name = _
"ListeMain.jsp?page=1&ts=1343843509938"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
For intZaehler = 2 To 45
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://portal.bvl.bund.de/psm/jsp/ListeMain.jsp?page=" & intZaehler, _
Destination:= _
Cells(lngZeile, 1))
.Name = "ListeMain.jsp?page=" & intZaehler
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
lngZeile = lngZeile + 35
Next intZaehler
Application.ScreenUpdating = True
End Sub
Es funktionert, aber dauert sehr lange. Außerdem werden damit nur die Inhalte als Text ausgelesen, Forderung ist jedoch, auch die enthaltenen Hyperlinks (irgendwie) in das Tabellenblatt mit zu übernehmen. Ich habe mir schon im Archiv die verschiedenen Beiträge angeschaut und auch in anderen Foren gesucht, aber noch keine Lösung für folgende Probleme gefunden:
1. Hyperlinks aus einer Webseite zu übernehmen
2. komfortabel mehrere Webseiten auszulesen
Hat jemand eine Lösung für diese beiden Probleme und wenn ja, wie würde diese aussehen?