@Philip und @volti: URL´s aus HTML Quellcode auslesen

Option Explicit
Sub WlwDeFirmenDatenAuslesen()
'Alle Werte werden in die Excel-Tabelle geschrieben,
'aus der das Makro gestartet wurde. Die Verwaltung
'der Excel-Tabelle führe ich "nebenbei" mit, ohne
'dazu groß etwas zu kommentieren
'Spalten können beliebig durch neue
'Festlegung angeordnet werden
'Es gibt keine Prüfung auf Doppelbelegung
Const spalteLogo As Byte = 1
Const spalteFirmenName As Byte = 2
Const spalteAdresse As Byte = 3
Const spalteWWW As Byte = 4
Const spalteMail As Byte = 5
Const spalteFirmenInfo As Byte = 6
Const spalteZertifizierungen As Byte = 7
Const spalteHersteller As Byte = 8
Const spalteDienstleister As Byte = 9
Const spalteHaendler As Byte = 10
Const spalteGrossHaendler As Byte = 11
Const spalteAusgelesenAm As Byte = 12
Const spalteAusgelesenUm As Byte = 13
Dim browserMain As Object
Dim browserSub As Object
Dim knotenSuchContainer As Object
Dim knotenAlleSuchTreffer As Object
Dim knotenEinSuchTreffer As Object
Dim url As String
Dim urlSeite As Long
Dim hoechsteSeite As Long
Dim hoechsteSeiteGeholt As Boolean
Dim aktuelleZeile As Long
Dim logoURL As String
Dim firmenName As String
Dim internetAdresse As String
Dim firmenInfo As String
Dim zertifizierungen As String
Dim anbieterArten As String
Dim buchstabeNr As Byte
Dim buchstabe As String
Dim detailURL As String
Dim adresse As String
Dim eMail As String
'Tabelle Kopfzeile und Grundformat
'Es findet keine Prüfung statt, ob die Tabelle leer ist
Cells.VerticalAlignment = xlCenter
ActiveSheet.Cells(1, spalteLogo).Value = "Logo"
ActiveSheet.Columns(spalteLogo).ColumnWidth = 22
ActiveSheet.Columns(spalteLogo).HorizontalAlignment = xlCenter
ActiveSheet.Cells(1, spalteLogo).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteLogo).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteLogo).Font.Bold = True
ActiveSheet.Cells(1, spalteLogo).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteLogo).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteFirmenName).Value = "Firmenname"
ActiveSheet.Columns(spalteFirmenName).ColumnWidth = 30
ActiveSheet.Columns(spalteFirmenName).NumberFormat = "@"
ActiveSheet.Columns(spalteFirmenName).WrapText = True
ActiveSheet.Cells(1, spalteFirmenName).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteFirmenName).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteFirmenName).Font.Bold = True
ActiveSheet.Cells(1, spalteFirmenName).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteFirmenName).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteAdresse).Value = "Adresse"
ActiveSheet.Columns(spalteAdresse).ColumnWidth = 30
ActiveSheet.Columns(spalteAdresse).NumberFormat = "@"
ActiveSheet.Columns(spalteAdresse).WrapText = True
ActiveSheet.Cells(1, spalteAdresse).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteAdresse).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteAdresse).Font.Bold = True
ActiveSheet.Cells(1, spalteAdresse).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteAdresse).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteWWW).Value = "Internet"
ActiveSheet.Columns(spalteWWW).ColumnWidth = 30
ActiveSheet.Cells(1, spalteWWW).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteWWW).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteWWW).Font.Bold = True
ActiveSheet.Cells(1, spalteWWW).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteWWW).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteMail).Value = "E-Mail"
ActiveSheet.Columns(spalteMail).ColumnWidth = 30
ActiveSheet.Cells(1, spalteMail).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteMail).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteMail).Font.Bold = True
ActiveSheet.Cells(1, spalteMail).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteMail).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteFirmenInfo).Value = "Firmeninfo"
ActiveSheet.Columns(spalteFirmenInfo).ColumnWidth = 40
ActiveSheet.Columns(spalteFirmenInfo).NumberFormat = "@"
ActiveSheet.Columns(spalteFirmenInfo).VerticalAlignment = xlTop
ActiveSheet.Columns(spalteFirmenInfo).WrapText = True
ActiveSheet.Cells(1, spalteFirmenInfo).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteFirmenInfo).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteFirmenInfo).Font.Bold = True
ActiveSheet.Cells(1, spalteFirmenInfo).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteFirmenInfo).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteFirmenInfo).WrapText = True
ActiveSheet.Cells(1, spalteZertifizierungen).Value = "Zertifizierungen"
ActiveSheet.Columns(spalteZertifizierungen).ColumnWidth = 30
ActiveSheet.Columns(spalteZertifizierungen).NumberFormat = "@"
ActiveSheet.Columns(spalteZertifizierungen).WrapText = True
ActiveSheet.Cells(1, spalteZertifizierungen).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteZertifizierungen).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteZertifizierungen).Font.Bold = True
ActiveSheet.Cells(1, spalteZertifizierungen).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteZertifizierungen).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteZertifizierungen).WrapText = True
ActiveSheet.Cells(1, spalteHersteller).Value = "Ist Hersteller"
ActiveSheet.Columns(spalteHersteller).ColumnWidth = 5.3
ActiveSheet.Columns(spalteHersteller).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteHersteller).NumberFormat = "0"
ActiveSheet.Cells(1, spalteHersteller).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteHersteller).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteHersteller).Orientation = 90
ActiveSheet.Cells(1, spalteHersteller).Font.Bold = True
ActiveSheet.Cells(1, spalteHersteller).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteHersteller).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteDienstleister).Value = "Ist Dienstleister"
ActiveSheet.Columns(spalteDienstleister).ColumnWidth = 5.3
ActiveSheet.Columns(spalteDienstleister).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteDienstleister).NumberFormat = "0"
ActiveSheet.Cells(1, spalteDienstleister).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteDienstleister).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteDienstleister).Orientation = 90
ActiveSheet.Cells(1, spalteDienstleister).Font.Bold = True
ActiveSheet.Cells(1, spalteDienstleister).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteDienstleister).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteHaendler).Value = "Ist Händler"
ActiveSheet.Columns(spalteHaendler).ColumnWidth = 5.3
ActiveSheet.Columns(spalteHaendler).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteHaendler).NumberFormat = "0"
ActiveSheet.Cells(1, spalteHaendler).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteHaendler).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteHaendler).Orientation = 90
ActiveSheet.Cells(1, spalteHaendler).Font.Bold = True
ActiveSheet.Cells(1, spalteHaendler).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteHaendler).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteGrossHaendler).Value = "Ist Großhändler"
ActiveSheet.Columns(spalteGrossHaendler).ColumnWidth = 5.3
ActiveSheet.Columns(spalteGrossHaendler).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteGrossHaendler).NumberFormat = "0"
ActiveSheet.Cells(1, spalteGrossHaendler).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteGrossHaendler).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteGrossHaendler).Orientation = 90
ActiveSheet.Cells(1, spalteGrossHaendler).Font.Bold = True
ActiveSheet.Cells(1, spalteGrossHaendler).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteGrossHaendler).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteAusgelesenAm).Value = "Geholt"
ActiveSheet.Columns(spalteAusgelesenAm).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteAusgelesenAm).ColumnWidth = 10
ActiveSheet.Columns(spalteAusgelesenAm).NumberFormat = "m/d/yyyy"
ActiveSheet.Cells(1, spalteAusgelesenAm).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteAusgelesenAm).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteAusgelesenAm).Font.Bold = True
ActiveSheet.Cells(1, spalteAusgelesenAm).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteAusgelesenAm).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, spalteAusgelesenUm).Value = "Um"
ActiveSheet.Columns(spalteAusgelesenUm).HorizontalAlignment = xlCenter
ActiveSheet.Columns(spalteAusgelesenUm).ColumnWidth = 10
ActiveSheet.Columns(spalteAusgelesenUm).NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
ActiveSheet.Cells(1, spalteAusgelesenUm).HorizontalAlignment = xlLeft
ActiveSheet.Cells(1, spalteAusgelesenUm).VerticalAlignment = xlBottom
ActiveSheet.Cells(1, spalteAusgelesenUm).Font.Bold = True
ActiveSheet.Cells(1, spalteAusgelesenUm).Interior.ThemeColor = xlThemeColorAccent2
ActiveSheet.Cells(1, spalteAusgelesenUm).Interior.TintAndShade = 0.399975585192419
ActiveSheet.Cells(1, 1).AutoFilter
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
'Zeile, ab der in die Excel-Tabelle geschrieben werden soll
aktuelleZeile = 2
'Vorabüberlegung:
'Wir müssen mehr als eine Seite aufrufen, um an die gewünschten
'Informationen zu gelangen
'Die Daten liegen also über mehrere Seiten verteilt. Deshalb gibt
'es, wie auf vielen anderen Seiten auch, eine Paginierung. Also
'eine Seitennummerierung. Ich verwende das Wort Paginierung hier
'ganz bewußt, denn man trifft es im Quelltext von HTML-Seiten
'immer wieder an. So auch auf dieser als CSS-Klasse:
'<ul class="pagination">
'  <li class="disabled">
'    <a href="#">
'      Vorherige
'    </a>
'  </li>
'  <li class="hidden-xs active">
'    <a href="#">
'      1
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=2">
'      2
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=3">
'      3
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=4">
'      4
'    </a>
'  </li>
'  <li class="disabled hidden-xs">
'    <a href="#">
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a rel="nofollow" href="/de/firmen/it-outsourcing?page=12">
'      12
'    </a>
'  </li>
'  <li><a href="/de/firmen/it-outsourcing?page=2">Nächste</a></li>
'</ul>
'Es gibt unterschiedliche Arten eine Paginierung durchzugehen. Wie man vorgeht, hängt
'immer von ihrer individuellen Gestaltung ab. Hier holen wir die höchste Seitenzahl
'über die CSS-Klasse "hidden-xs" aus dem letzten li-Tag mit dieser CSS-Klasse innerhalb
'von "pagination". Das passiert über eine sogenannte NodeCollection. Was es damit auf
'sich hat, erkläre ich weiter unten einmal für den Fall, dass man gezielt auf ein
'bestimmtes Element zugreifen möchte (in der Funktion 'HoechsteSeitenZahl()') und wenn
'man mit For-Each durch alle Elemente gehen will (durch jede gelistete Firma)
'Die erste Seite ist immer 1
urlSeite = 1
'Da diese auf jeden Fall vorhanden ist, verwenden wir eine fußgesteuerte Schleife
'Das bedeutet, die Abbruchbedingung wird am Ende des Schleifenkörpers geprüft,
'während das bei einer kopfgesteuerten Schleife passiert, bevor der Code im
'Schleifenkörper das erste Mal ausgeführt wurde
'Kopfgesteuert = Code in der Schleife wird eventuell 0x ausgeführt
'Fußgesteuert = Code in der Schleife wird mindestens 1x ausgeführt
'Es wäre mit dem Wissen um die höchste Seitenzahl übrigens möglich eine For-Schleife
'zu verwenden. Dazu müssten wir aber einen Aufruf der Seite vorab durchführen, um an
'die Zahl zu gelangen. Den sparen wir uns, indem wir eine Do-Schleife, eine eigene
'Zähl-Variable und eine Prüf-Variable vom Typ Boolean verwenden. Letztere um das
'wiederholte Auslesen der höchsten Seitenzahl zu vermeiden
'Eine For-Schleife ist übrigens immer kopfgesteuert, während wir eine Do-Schleife
'sowohl kopf- wie auch fußgesteuert einsetzen können
Do
'Kurze URL-Kunde (URL = Uniform Resource Locator):
'An dieser Stelle geht es mir nicht um Domains, Subdomains, Protokolle und den
'ganzen Blub, sondern um die beiden Teile Seitenaufruf und Parameter, die den
'Seitenaufruf gezielt beeinflussen
'Der angegebene Link (URL) war:
'https://www.wlw.de/de/firmen/it-outsourcing
'Damit kommen wir auf die erste Seite der auszulesenden Firmendaten
'Klickt man in der Paginierung die 2 an, verändert sich der Link
'Da steht dann nämlich plötzlich:
'https://www.wlw.de/de/firmen/it-outsourcing?page=2
'Der vordere Teil (Seitenaufruf) ist gleich geblieben, wurde aber um "?page=2"
'Erweitert. Dabei handelt es sich um einen Parameter. In diesem Fall gibt der
'sehr offensichtlich an, welche Seite aufgerufen werden soll. Auf anderen
'Seiten gibt es aber auch sehr kryptische Parameter und man muss etwas
'rumprobieren, was die im Einzelnen bewirken. Oft findet man es nicht raus ;-)
'In diesem "nicht rausfinden" ist aber ein sehr gutes Potential enthalten:
'Was nix an dem ändert, was wir aufrufen wollen, kann weggelassen werden!
'Es ist erstaunlich wie kurz man manche URLs machen kann, wenn man weiß,
'was alles nicht benötigt wird
'Aber zurück zu den Parametern
'Das es sich bei "?page=2" um einen Parameter handelt ist nicht ganz richtig
'Viel mehr haben wir es auch hier mit 2 Teilen zu tun. Nämlich dem "?" und
'"page=2". Nur letzteres ist der Parameter. Das Fragezeichen hingegen leitet
'die Parameterliste einer URL ein. Das ist immer so! Sobald das Fragezeichen
'auftaucht kann man sich darauf verlassen, jetzt kommt der erste Parameter
'Weitere Parameter werden immer über das Kaufmannsund (&) abgeteilt. Auf
'dieser Seite habe ich es nicht gesehen, aber sowas wie:
'www.blobsnase.de/wichtigesUnterverzeichnis/blub?Parm1&Parm2&Parm3
'hat nach den genannten Regeln leicht erkennbar 3 Parameter
'Wir nutzen hier "page=". Der funktioniert übrigens (nach meiner Erfahrung)
'immer auch für Seite 1. Das erleichtert das Programmieren, weil es keinen
'Sonderfall für die erste aufzurufende Seite gibt
url = "https://www.wlw.de/de/firmen/it-outsourcing?page=" & urlSeite
'Die Schnittstelle für den Seitenaufruf:
'Wir nutzen einfach den IE. Für viele Lösungen wäre der Weg über
'"MSXML2.XMLHTTP", den ChrisL in seiner Lösung verwendet hat,
'schneller, um das Auslesen durchzuführen. Trotzdem belasse ich
'es beim IE. Die meiste Zeit geht für die Reaktionszeit vom Server
'drauf. Da wir zu jeder Firma eine eigene Seite aufrufen müssen,
'machen die Reaktionszeiten den Löwenanteil der aufgewendeten
'Zeit aus
'Zum Entwickeln würde ich eh immer den IE benutzen, weil er
'eine Sichtkontrolle ermöglicht. Bei der Verwendung von
'"MSXML2.XMLHTTP" gibt es kein GUI (Graphical User Interface)
'Man sieht also nicht, was gerade passiert und viel wichtiger,
'an welcher Stelle der Entwicklungsstand rumzickt
'Aber eine kurze Erklärung dazu, welche Schnittstelle man wann
'verwenden kann:
'Sobald man auf dynamische Inhalte angewiesen ist, kommt man nicht
'um eine Schnittstelle herum, die damit umgehen kann. Was sind nun
'wieder dynamische Inhalte? Alles was eine Programmierung innerhalb
'einer Seite verwendet. Macht es nicht besser irgendwie. Naja, in
'der Regel werden dynamische Inhalte durch JavaScript(kurz JS)
'erzeugt
'Um uns nix vorzumachen, die meisten Seiten benutzen JS und deshalb
'verwende ich in der Regel den IE. Das ist ein vollständiger Browser
'mit integriertem Interpreter für JS, CSS und ganz nebenbei verwaltet
'er auch noch Cookies halbautomatisch für uns (man muss sie oft einmal
'manuell akzeptieren und anschließend funktionieren sie einfach)
'Oft werden dynamische Inhalte über JS als sogenanntes AJAX integriert
'AJAX = Asynchronous JavaScript and XML
'AJAX ermöglicht solche Sachen wie das Einblenden von Seiteninhalten
'durch das Anklicken eines Links. Da geht dann oft einfach ein
'Kästchen nach unten auf und weitere Inhalte werden angezeigt. Das
'Ding dabei ist, AJAX-Inhalte werden erst vom Server angefordert, wenn
'z.B. ein Link angeklickt wird oder man auf einer Seite runterscrollt
'Auf der vorliegenden Seite werden die Logo-Grafiken der Firmen z.B.
'erst geladen, wenn sie in den sichtbaren Scrollbereich kommen. Genau
'das funktioniert aber mit "MSXML2.XMLHTTP" nicht. "MSXML2.XMLHTTP"
'kann mit dynamischen Inhalten nix anfangen
'Ok, die Logos kann man trotzdem auslesen, weil man dazu nur die URLs
'zu den Bildern braucht Die stehen einfach im Quelltext. Aber z.B.
'Facebook lädt immer mehr Inhalte nach, je weiter man nach unten scrollt
'Mit "MSXML2.XMLHTTP" würde man nur auf die Inhalte zugreifen können,
'die beim Aufruf der Seite geladen werden
'Auch weil ich mich damit bisher nicht wirklich beschäftigt habe, gehe
'ich auf Selenium an dieser Stelle bewusst nicht ein. Nur soviel: Damit
'lassen sich auch andere Browser als der IE via VBA steuern und somit
'lassen sich natürlich auch dynamische Inhalte verarbeiten. Der IE lässt
'sich direkt via VBA steuern, weil er eine COM-Schnittstelle hat, die
'anderen Browsern fehlt
'COM = Component Object Model
'https://de.wikipedia.org/wiki/Component_Object_Model
'Folgendes Prozedere jede Auseleserunde, denn der IE ist eine Diva
'weshalb wir ihn für jeden Seitenaufruf neu initialisieren
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browserMain = CreateObject("internetexplorer.application")
browserMain.Visible = False 'Während der Entwicklung unbedingt auf True setzen
browserMain.navigate url
Do Until browserMain.ReadyState = 4: DoEvents: Loop
'Manuelle Pause, damit die Seite komplett zur Verfügung steht, wenn es
'Inhalte gibt, die noch nachgeleaden werden müssen (z.B. iFrame Dokumente)
'Application.Wait (Now + TimeSerial(Pause_Stunden, Pause_Minuten, Pause_Sekunden))
'(Wird für diese Seite nicht benötigt)
'Application.Wait (Now + TimeSerial(0, 0, 2))
'Beim Aufruf von Seite 1 müssen wir die Anzahl der aufzurufenden Seiten
'feststellen. Wir lagern diese Aufgabe in eine Funktion aus, die nur
'einmal aufgerufen wird. Damit sie nur einmal aufgerufen wird, Speichern
'wir genau das in einer Variable vom Typ Boolean und prüfen darauf
'In VBA ist der Dafault-Wert von Boolean False, weshalb wir diese Variable
'nicht initialisieren mussten, wie die Variable 'seite' mit 1. Die Variable
'seite' ist eine numerische Variable und diese haben als Dafault-Wert immer
'die 0 (Null). Wir starten aber von Page=1 (siehe oben)
'Prüfen ob die höchste Seitenzahl schon ausgelesen wurde
If hoechsteSeiteGeholt = False Then
'Wenn noch nicht, ausgelesen
'(Holen der höchsten Seitenzahl ausgelagert in eine Funktion)
hoechsteSeite = HoechsteSeitenZahl(browserMain.document)
'Beim nächsten Durchlauf das erneute Auslesen vermeiden
hoechsteSeiteGeholt = True
End If
'Die grundlegende Struktur, um alle Suchseiten in einer Schleife durchzugehen,
'ist an dieser Stelle geschaffen. Jetzt geht es darum auf die Inhalte zuzugreifen
'die in die Excel Tabelle geschrieben werden sollen
'Um den HTML-Code einer Seite zu analysieren ist es am einfachsten im Browser F12
'zu drücken. (Ich verwende FireFox, weshalb einige Vokabeln für andere Browser
'anders sein können). Es erscheint unten im Browserfenster ein Bereich, der mehrere
'Tabs enthält. Im Normalfall befindet man sich bereits direkt auf dem Tab "Inspektor"
'Im Tooltip dieses Tabs wird auf das DOM hingewiesen, mit dem wir im Kern arbeiten
'und dessen Wesen ich in der Funktion HoechsteSeitenZahl() in Kurzform erklärt habe
'Hier kann man sich durch den DOM-Baum klicken. Praktischerweise wird im oberen Bereich
'des Browsers, also auf der Seitendarstellung selbst, immer die HTML-Struktur hervor
'gehoben, auf der man sich im Inspektor mit dem Mauszeuger befindet
'Generell ist es so, dass auf Seiten mit Suchergebnissen (aber auch z.B. in Foren) ein
'Muster besteht, wie die Daten aufgeführt werden. Es gibt Datencontainer. Oft einen,
'der die Auflistung aller Suchergebnisse beinhaltet. Die Suchergebnisse selbst sind
'dann alle wiederum in gleichartigen Strukturen abgelegt. So auch auf dieser Seite,
'womit es sehr leicht wird alle Suchtreffer der Seite durchzugehen. Ganz egal wieviele
'es sind
'Geht man über F12 und den Inspektor, trifft man unweigerlich auf den Abschnitt, der
'unsere gewünschten Daten in article-Tags enthält. Den gesamten HTML-Code hier abzubilden,
'wenn alle Knoten aufgeklappt sind, wäre nicht sehr zielführend und vor allem sehr lang
'Wir haben es wie gesagt auf die Tags mit dem Namen "article" abgesehen, denn die enthalten
'jeweils Informationen zu genau einer Firma. Dadurch, dass man einen dieser Tags nach dem
'anderen abarbeitet, ist automatisch sichergestellt, dass alle ausgelesenen Infos zu der
'gleichen Firma gehören
'Ich kürze die Seitenanalyse an dieser Stelle mal etwas ab. Unter anderem ist die Adresse
'und die E-Mail Adresse einer Firma gewollt. Für die E-Mail Adresse muss sowieso eine
'weitere Seite aufgerufen werden. Dort befindet sich auch nochmal die Adresse der Firma,
'nur ergänzt um die Straße mit Hausnummer. Deshalb lese ich diese Information dort aus
'Zum grundsätzlichen Vorgehen ist noch zu sagen, es gibt zwei Vorgehensweisen. Ich nenne
'sie horizontal und vertikal. Das bezieht sich darauf Daten zeilenweise oder spaltenweise
'in der Exceltabelle einzutragen. Ich persönlich bin ein großer Freund des zeilenweisen
'Vorgehens. Das stellt sicher, dass ein Datensatz vollständig ist, sobald in die Folgezeile
'gewechselt wird. Beim (teilweise) spaltenweisen Befüllen mit Daten hat man mitunter wieder
'das Problem, welche Informationen zu welchem Datensatz gehören
'Für die vorliegende Anforderung holen wir jeweils Daten von zwei unterschiedlichen Seiten
'Einmal aus den Suchergebnissen selbst und Adresse sowie E-Mail Adresse aus einer weiteren
'Seite, deren URL wir erst aus den Suchergebnissen erfahren. Horizontal vorzugehen, also
'eine Datensatzzeile zu vervollständigen, bedeutet, dass wir die benötigte zweite Seite
'für jeden "article" aufrufen, sobald wir ihn am Wickel haben. Vertikales Vorgehen würde
'bedeuten, wir holen erst alle Daten aus den Suchseiten und anschließend vervollständigen
'wir alle Datensätze durch das abklappern aller "zweiten Seiten". Das geht auch und ist
'mitunter auch sinnvoll. Z.B. wenn man nach einem Makroabbruch die Möglichkeit einbauen
'will, die Daten an der Stelle weiter auszulesen, an der das Makro unterbrochen wurde
'Alle article-Tags sind in einem section-Tag gekapselt. Dieses hat eine ID mit der
'Bezeichnung "init-chunk", über die wir es mit der Methode getElementByID() separieren
'können. Diese Methode holt nur ein einziges Element, denn eine ID darf laut DOM Standard
'nur einmal in einem HTML-Dokument vorkommen
'Achtung: Nicht alle Seiten halten sich an diesen Standard. Also immer unbedingt prüfen,
'ob eine ID wirklich nur einmal im Quelltext einer Seite vorkommt! Wenn nicht, muss man
'sich etwas anderes überlegen, um an das gewünschte zu kommen, ausser es steht im ersten
'Element mit der mehrfach verwendeten ID
'Vergleicht man die Namen der get-Methoden, die ich in der Funktion HoechsteSeitenZahl()
'aufgeführt habe, fällt auf, dass es dort immer getElements heißt, während es für das
'Abgreifen einer HTML-Struktur über eine ID getElement heißt. Eine kleines s mit großer
'Wirkung. Für getElementByID() wird nämlich keine NodeCollection gebildet, weil es ja
'keine Sammlung als solches gibt. Deshalb gibt es auch keinen Index, den man verwenden
'muss, um auf das einzige Element zuzugreifen, das sich ergibt
'Eine weitere Folge ist, während wir bei den getElements Methoden einfach hinterher
'prüfen können, ob eine NodeCollection gebildet werden konnte, funktioniert das hier
'nicht einfach über Not ... Nothing. Ist eine ID nicht vorhanden, wirft VBA gnadenlos
'einen Laufzeitfehler. Das wollen wir natürlich nicht und deshalb nutzen wir einen
'kleinen Trick, der uns doch die Verwendung von Not ... Nothing ermöglicht
'Wir schalten die Fehlerkontrolle ab, versuchen das Objekt über die ID zu bilden und
'schalten die Fehlerkontrolle anschließend sofort wieder ein
On Error Resume Next
Set knotenSuchContainer = browserMain.document.getElementByID("init-chunk")
On Error GoTo 0
'Entweder konnte das Objekt gebildet werden oder nicht
If Not knotenSuchContainer Is Nothing Then
'Alle article-Tags aus dem Suchcontainer in eine NodeCollection schreiben
Set knotenAlleSuchTreffer = knotenSuchContainer.getElementsByTagName("article")
'Hier fällt auf, dass am Ende der Zeile kein Index für den Zugriff auf ein
'bestimmtes Element gesetzt wurde. Vielmehr haben wir nun eine NodeCollection,
'die alle verfügbaren Tags mit dem Namen article aus der HTML-Struktur des
'Suchcontainers in sich vereint. Wir gehen jeden Knoten mit einer For Each
'Schleife durch. Auch hier sparen wir uns die Prüfung, ob die NodeCollection
'gebildet werden konnte, weil ein Suchcontainer ohne Inhalt einfach keinen
'Sinn macht (obwohl das bei Seitenladefehlern durchaus vorkommen könnte)
For Each knotenEinSuchTreffer In knotenAlleSuchTreffer
'Tabelle scrollen ab Zeile 5, um den Fortschritt
'im Blick zu behalten
If aktuelleZeile > 4 Then
ActiveWindow.SmallScroll Down:=1
End If
'Ich gehe auch an dieser Stelle nicht näher auf den HTML-Code eines
'einzelnen article-Tags ein. Wichtig ist, dass wir ab hier alles auslesen
'können, was es an Informationen gibt, wenn wir wollen. Das beinhaltet
'neben allem was Text ist z.B. auch die Grafiken der Logos
'Es kommt auch vor, dass man Informationen bekommen kann, die auf der
'Seite selbst gar nicht sichtbar sind. Diese verbergen sich vor allem
'in den Attributen von HTML-Tags, aber auch in JavaScript Abschnitten
'Auf der vorliegenden Seite gibt es sehr viele Attribute. Z.B. diese beiden:
'"data-customer-id" und "data-company-id". Ich weiß nicht wofür die stehen,
'aber sie ließen sich wahrscheinlich gut verwenden, um einem Datensatz eine
'einmalige ID zu verpassen, wenn benötigt. Es kommt auch vor, dass man einen
'gewünschten Wert identifizieren kann, weil er ein bestimmtes Attribut besitzt
'oder nicht besitzt. Für Attribute gibt es die beiden Methoden getAttribute()
'und hasAttribute()
'Was wir auslesen wollen (und wo wir es finden):
'Logo (Suchergebnis)
'Firmenname (Suchergebnis)
'Internet-Adresse (Suchergebnis)
'Firmeninfo (Suchergebnis)
'Zertifizierungen (Suchergebnis)
'Ob Hersteller (Suchergebnis)
'Ob Dienstleister (Suchergebnis)
'Ob Händler (Suchergebnis)
'Ob Großhändler (Suchergebnis)
'Link auf Firmendetails (Suchergebnis)
'Adresse inkl. Straße (Firmendetails)
'E-Mail Adresse (Firmendetails)
'Zusätzlich tragen wir für jeden Datensatz einen Zeitstempel ein,den
'wir auf zwei Spalten für Datum und Uhrzeit aufteilen
'An dieser Stelle kurz etwas dazu, wie auf Inhalte zugegriffen wird
'Es sollte vermieden werden Inhalte über andere inhalte zu identifizieren
'Viel mehr sollte eine Separierung möglichst immer über die Struktur der
'Seite erfolgen. Seiten unterliegen mitunter Änderungen, es ist aber
'wesentlich nachhaltiger Inhalte über Tagnamen, CSS-Klassennamen, IDs und
'Attribute zu identifizieren, als über Vergleiche von Beschriftungen
'Manchmal geht es nicht anders, als über Textvergleiche. Aber liest
'man z.B. Daten von einer mehrsprachigen Seite aus, ist man machmal
'darauf angewiesen z.B. auf der Deutschen Version zu arbeiten und
'manchmal auf der Englischen Version. Die Struktur der Seite ist in
'beiden Fällen erfahrungsgemäß die gleiche. Die Beschriftung ist es
'ganz sicher nicht. Noch deutlicher wird es, wenn man es mit Seiten
'zu tun hat, deren Schrift man gar nicht kennt. Z.B. kyrillisch,
'chinesisch, japanisch oder sonstige
'Logo
'Zur Vorbereitung passen wir die Zeilenhöhe der aktuellen Zeile für die Bildhöhe an
ActiveSheet.Rows(aktuelleZeile).RowHeight = 90
'Um Grafiken in einer Tabelle mitsortieren zu können, werden in den Zellen, auf denen
'sie liegen, Werte benötigt. Am einfachsten ist es die Zeilennummern einzutragen
'Damit kann man die Tabelle zu jedem Zeitpunkt auch wieder in die Reihenfolge
'sortieren, in der die Datensätze ausgelesen wurden
ActiveSheet.Cells(aktuelleZeile, spalteLogo).Value = aktuelleZeile
'Da nicht in jeder Zelle Logos liegen werden, wechseln wir die Schriftfarbe für
'diese IDs auf weiß. Baut man noch sowas ein wie alternierendes Einfärben der
'Hintergrundfarbe für die Zeilen, muss man die Schriftfarbe entsprechend
'dynamisch mit im Change-Event der Tabelle verwalten
ActiveSheet.Cells(aktuelleZeile, spalteLogo).Font.ThemeColor = xlThemeColorDark1
ActiveSheet.Cells(aktuelleZeile, spalteLogo).Font.TintAndShade = 0
'Link zur Grafik des Firmenlogos holen
logoURL = FirmenLogoUrlHolen(knotenEinSuchTreffer)
'Konnte ein Link ausgelesen werden, Bild in Logo-Spalte platzieren
If Len(logoURL) > 0 Then
'Bild mittig in die Zelle einfügen
'Bild an die Zelle heften, damit es mitsortiert werden kann
'(die notwendige Zeilennummer in der Zelle, für die Ermöglichung
'der Mitsortierung wurde schon eingetragen)
'Die Logos werden in Originalgröße übernommen, womit wir uns das
'Ausrechnen der Seitenlängen bezogen auf das Seitenverhältnis sparen
ActiveSheet.Shapes.AddPicture(logoURL, False, True, _
ActiveSheet.Cells(aktuelleZeile, spalteLogo).Left + 5, _
ActiveSheet.Cells(aktuelleZeile, spalteLogo).Top + 5, _
-1, -1).Select
Selection.Placement = xlMoveAndSize
End If
'Firmenname
firmenName = FirmenNameHolen(knotenEinSuchTreffer)
If Len(firmenName) > 0 Then
ActiveSheet.Cells(aktuelleZeile, spalteFirmenName).Value = firmenName
End If
'Internet Adresse
internetAdresse = InternetAdresseHolen(knotenEinSuchTreffer)
'Die ausgelesene Internet Adresse wird als Link in die Tabelle eingetragen,
'wenn eine ausgelesen werden konnte
If Len(internetAdresse) > 0 Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(aktuelleZeile, spalteWWW), _
Address:="https://" & internetAdresse, TextToDisplay:=internetAdresse
End With
End If
'Firmeninfo
firmenInfo = FirmenInfoHolen(knotenEinSuchTreffer)
If Len(firmenInfo) > 0 Then
ActiveSheet.Cells(aktuelleZeile, spalteFirmenInfo).Value = firmenInfo
End If
'Zertifizierungen
zertifizierungen = ZertifizierungenHolen(knotenEinSuchTreffer)
If Len(zertifizierungen) > 0 Then
ActiveSheet.Cells(aktuelleZeile, spalteZertifizierungen).Value = zertifizierungen
End If
'Anbieterarten
'Alle 4 möglichen Anbieterarten prüfen
anbieterArten = AnbieterArtHolen(knotenEinSuchTreffer)
'Den Ergebnisstring bestehend aus 0en und 1en durchgehen
For buchstabeNr = 1 To Len(anbieterArten)
buchstabe = Mid$(anbieterArten, buchstabeNr, 1)
Select Case buchstabeNr
Case 1
If buchstabe = "a" Then
ActiveSheet.Cells(aktuelleZeile, spalteHersteller).Value = 1
End If
Case 2
If buchstabe = "a" Then
ActiveSheet.Cells(aktuelleZeile, spalteDienstleister).Value = 1
End If
Case 3
If buchstabe = "a" Then
ActiveSheet.Cells(aktuelleZeile, spalteHaendler).Value = 1
End If
Case 4
If buchstabe = "a" Then
ActiveSheet.Cells(aktuelleZeile, spalteGrossHaendler).Value = 1
End If
End Select
Next buchstabeNr
'Ab hier brauchen wir noch zwei Werte, für die wir die Detailseite ansurfen müssen
'Firmendetails URL holen und in weiterem IE aufrufen
detailURL = DetailUrlHolen(knotenEinSuchTreffer)
'Internet Explorer initialisieren, Sichtbarkeit festlegen,
'URL aufrufen und warten bis Seite vollständig geladen wurde
Set browserSub = CreateObject("internetexplorer.application")
browserSub.Visible = False 'Während der Entwicklung unbedingt auf True setzen
browserSub.navigate detailURL
Do Until browserSub.ReadyState = 4: DoEvents: Loop
'Adresse
adresse = AdresseHolen(browserSub.document)
ActiveSheet.Cells(aktuelleZeile, spalteAdresse).Value = adresse
'E-Mail
eMail = EmailHolen(browserSub.document)
'Man kann die Mailadresse auch als Link eintragen
'Hier wird es bewußt als einfache Zeichenkette gemacht
ActiveSheet.Cells(aktuelleZeile, spalteMail).Value = eMail
'Zweitbrowser schließen
browserSub.Quit
Set browserSub = Nothing
'Zeitstempel
'Auslesedatum eintragen
ActiveSheet.Cells(aktuelleZeile, spalteAusgelesenAm).Value = Int(Now())
'Ausleseuhrzeit eintragen
ActiveSheet.Cells(aktuelleZeile, spalteAusgelesenUm).Value = Now() - Int(Now())
aktuelleZeile = aktuelleZeile + 1
Next knotenEinSuchTreffer
Else
'Es gibt keinen Suchcontainer ... Abbruch des Makrolaufs
MsgBox "Es wurden keine Suchergenisse gefunden. " & Chr(13) & _
"Zur Sichtkontrolle wird der IE eingeblendet" & Chr(13) & _
"Das Makro wird beendet"
browserMain.Visible = True
Exit Sub
End If
'Vorbereitung nächste Runde inklusive Speicher aufräumen
urlSeite = urlSeite + 1
browserMain.Quit 'Die Diva IE zickt gern, deshalb jede Auselserunde beenden
'Speicher aufräumen muss nicht sein, finde ich aber konsequent
Set browserMain = Nothing
Set knotenSuchContainer = Nothing
Set knotenAlleSuchTreffer = Nothing
Set knotenEinSuchTreffer = Nothing
'Da die Festlegung der potenziell nächsten auszulesenden Seite erste am Ende der
'Schleife erfolgte (paar Zeilen weiter oben), wurde die höchste Seite ausgelesen,
'wenn die Variable für die nächste auszulende Seite größer ist, als die Variable
'für die zuletzt ausgelesene Seite. Das ist unsere Abbruchbedingung für die alles
'einfassende Schleife und somit das Ende des Auslesevorganges :-)
Loop Until urlSeite > hoechsteSeite
'Tabelle ab Zeile 1 anzeigen
ActiveSheet.Cells(2, 1).Select
ActiveSheet.Cells(1, 1).Select
End Sub
Private Function HoechsteSeitenZahl(htmlDocument As Object) As Long
Dim knotenPaginierung As Object
Dim knotenAlleLiTags As Object
Dim ausgeleseneSeitenzahl As Long
'Diese Funktion nimmt über den Funktionsparameter "htmlDocument"
'den gesamten HTML-Code der ersten Seite entgegen. Wir "schneiden"
'in einem ersten Schritt die Paginierung "heraus"
'Dieses "heraus schneiden" wird über das generieren einer NodeCollection
'erreicht. Diese wird über die get-Methoden getElementsByTagName(),
'getElementsByName() oder getElementsByClassName() gebildet. Um die
'Seitennummerierung zu separieren verwenden wir getElementsByClassName()
'Class bezieht sich dabei auf die zugewiesene CSS-Klasse von HTML-Elementen
'Wie das Wort Collection sagt, handelt es sich um eine Sammlung. Nämlich
'um eine Sammlung aller HTML-Elemente, die dem gleichen Auswahlkriterium
'in den Klammern unterliegen. Um auf ein bestimmtes Element zugreifen zu
'können, sind die Elemente einer NodeCollection mit Indizes versehen. Das
'erste Element trägt dabei immer den Index 0
'Da es die CSS-Klasse "pagination" nur ein einziges mal gibt, hat das
'benötigte HTML-Element den Index 0. Um direkt auf diesen zuzugreifen,
'wird er in Klammern hinten angestellt. Das erinnert sehr an ein Array,
'es ist aber keins
Set knotenPaginierung = htmlDocument.getElementsByClassName("pagination")(0)
'Jetzt sollte sich in der Variablen knotenPaginierung ein Verweis auf das
'Objekt befinden, welches wir mit dem Teil nach dem = erzeugen wollten
'Genau genommen handelt es sich um ein DOM-Objekt. DOM steht für "Document
'Object Model". Bürokratisch verbirgt sich dahinter die Spezifikation des
'W3C für den Aufbau einer Intenetseite. Da steht eine Menge Zeugs drin,
'vom dem wir für unsere Zwecke nur einen Bruchteil benötigen. Für uns ist
'nur wichtig, dass eine Internetseite als Baum-Struktur hinterlegt ist
'Ein Baum ist im Sinne des Programmierens ein gerichteter Graph.  Aber das
'ist auch völlig unwichtig. Wichtig ist seine Struktur, auf die wir u.a.
'über die Get-Methoden zugreifen können, um an HTML-Inhalte zu kommen
'Wie gesagt, sollte das Objekt gebildet worden sein. Aber gerade beim
'Web Scraping ist das nicht zwingend der Fall. Deshalb sollte man auf
'jeden Fall die Objekte auf vorhanden sein Prüfen, die vielleicht nicht
'gebildet werden konnten. Auf der vorliegenden Seite stehen bei manchen
'Firmen z.B. Zertifizierungen in den Suchergebnissen, bei manchen nicht
'Will man die auslesen, muss man prüfen, ob sie überhaupt vorhanden sind
'Die Prüfung, ob ein Objekt vorhanden ist, erfolgt über die auf den ersten
'Blick merkwürdige Doppelverneinung "Not ... Nothing"
If Not knotenPaginierung Is Nothing Then
'Umgangssprachlich lautet die Zeile:
'"Wenn knotenPaginierung nicht Nichts ist, dann"
'Das einzige was man verstehen muss ist eigentlich, dass ein Objekt
'irgendwo im Speicher liegt und eine Objekt-Variable nur den Verweis
'auf den Speicherberich enthält, wo dieses Objekt liegt. Gibt es kein
'Objekt gibt es keinen verwendeten Speicherbereich. Auch dass muss
'abgebildet werden. Das passiert über das Schlüsselwort "Nothing"
'Wenn in der Objektvariablen nicht (Not) Nothing steht, dann gibt
'es das Objekt
'Aus dem gesamten HTML-Quelltext der Seite haben wir jetzt den folgenden
'in der Variable knotenPaginierung isoliert. Dadurch, dass es mehrere
'HTML-Zeilen sind wird auch direkt klar, ein HTML-Element in einer
'NodeCollection kann zwar nur einen einzigen HTML-Tag enthalten, in der
'Regel ist es aber eine HTML-Struktur:
'<ul class="pagination">
'  <li class="disabled">
'    <a href="#">
'      Vorherige
'    </a>
'  </li>
'  <li class="hidden-xs active">
'    <a href="#">
'      1
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=2">
'      2
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=3">
'      3
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a href="/de/firmen/it-outsourcing?page=4">
'      4
'    </a>
'  </li>
'  <li class="disabled hidden-xs">
'    <a href="#">
'    </a>
'  </li>
'  <li class="hidden-xs">
'    <a rel="nofollow" href="/de/firmen/it-outsourcing?page=12">
'      12
'    </a>
'  </li>
'  <li><a href="/de/firmen/it-outsourcing?page=2">Nächste</a></li>
'</ul>
'Auf dieses HTML-Element lassen sich weiterhin alle Methoden des DOM anwenden
'genau das nutzen wir aus, indem wir das letzte li-Tag mit der CSS-Klasse
'"hidden-xs" separieren. Denn in dem steht für diese Seite die höchste
'aufzurufende Seitenzahl, die wir für die Anzahl der Schleifendurchläufe
'im Hauptmakro benötigen
Set knotenAlleLiTags = knotenPaginierung.getElementsByClassName("hidden-xs")
'Wir haben hier auf den direkten Zugriff auf einen bestimmten Index verzichtet, weil
'wir ihn nicht kennen. Was wir wissen ist, der gesuchte Wert steht im letzten
'Element der gebildeten NodeCollection. Wie bei Objekten üblich, besitzt sie Methoden
'und Eigenschaften. Die Get-Methoden habe ich schon erwähnt. Eine Eigenschaft ist
'"Length". Length enthält die Anzahl der Elemente der NodeCollection. Da die
'Indizierung bei 0 beginnt, muss von Length 1 abgezogen werden, um auf das Element
'mit dem höchsten Index zuzugreifen
'(Auf die Not ... Nothing Prüfung verzichten wir hier übrigens, weil es wahrscheinlich
'ist, dass es eine Seitennummerierung gibt, wenn es eine Paginierung gibt)
'Wir können den ausgelesenen Wert direkt einer Variablen vom Datntyp Long zuweisen. Ist
'nicht sicher, ob wirklich eine Zahl ausgelesen wird, benutzt man eine Variable vom
'Datentyp String. Anschließend kann man diesen Prüfen und ggf. in einen anderen
'Datentyp umwandeln
'Über innertext liest man den Teil eines Elements der NodeCollection aus, der im
'Browser für uns auf der Seite sichtbar ist. Es wird wirklich der gesamte Text des
'ganzen Elements geliefert. Würden wir innertext also auf unsere Variable
'knotenPaginierung anwenden, bekämen wir alle Zahlen und die drei Punkte (müsste
'man dann natürlich in einem String ablegen) In der Regel kommt da aber nix
'vernünftiges bei raus, weil es keine Formatierungen gibt. Der gesamte Text wird
'einfach hintereinander weg geliefert
'Gibt es keine Freizeichen bedeutet das für unser Beispiel, man bekäme den String
'1234...12 zurück geliefert. Für den Fall dass es Freizeichen gibt, wollen wir die
'aber nicht haben, sofern sie sich am Anfang oder Ende befinden. Deshalb kapseln
'wir ganz stumpf alles was wir über innertext auslesen in der Trim()-Methode
ausgeleseneSeitenzahl = Trim(knotenAlleLiTags(knotenAlleLiTags.Length - 1).innertext)
End If
'Aufräumen:
Set knotenPaginierung = Nothing
Set knotenAlleLiTags = Nothing
'Der Rückgabewert dieser Funktion ist die ausgelesene Seitenzahl. Wurde keine ausgelesen,
'bleibt der Wert der Variablen 0, wie oben erklärt
HoechsteSeitenZahl = ausgeleseneSeitenzahl
End Function
Private Function FirmenLogoUrlHolen(htmlDocument As Object) As String
Dim nodeImage As Object
Dim imageURL As String
'Die URL zur Logo-Grafik liegt im ersten img-Tag des übergebnenen DOM-Objektes
'"htmlDocument". img steht dabei für Image, also für Bild. Das img-Tag enthält
'über das Attribut src immer einen Link zur Quelle des Bildes. Genau diesen
'Link kann man direkt abgreifen
Set nodeImage = htmlDocument.getElementsByTagName("img")(0)
If Not nodeImage Is Nothing Then
'URL direkt aus dem Attribut src auslesen
imageURL = nodeImage.src
'Auf dieser Seite wird der Link auf die Grafik oft in des Attribut
'"data-src" ausgelagert. Im Attribute Source steht dann etwas, was die Seite
'selbst vermutlich braucht
If InStr(1, imageURL, "data:image/gif;base64,") > 0 Then
'Wir prüfen auf das Attribut und lesen es ggf aus
If nodeImage.hasAttribute("data-src") Then
imageURL = "https:" & nodeImage.getAttribute("data-src")
End If
End If
'URL löschen, wenn "/placeholder/" enthalten ist
'Ist die Zeichenkette "/placeholder/" enthalten,
'wird eine Ersatzgrafik geladen, weil kein Logo
'vorhanden ist. Die wollen wir aber nicht
If InStr(1, imageURL, "/placeholder/") > 1 Then
imageURL = ""
End If
End If
'Aufräumen:
Set nodeImage = Nothing
'Der Rückgabewert ist der ausgelesene Link. Wurde kein Link ausgelesen oder
'wurde festgestellt, dass es nur die Platzhaltergrafik statt eines Logos gibt,
'wird eine leere Zeichenkette zurückgegeben
FirmenLogoUrlHolen = imageURL
End Function
Private Function FirmenNameHolen(htmlDocument As Object) As String
Dim nodeFirmenName As Object
Dim firmenName As String
'Der Firmenname steht an verschiedenen Stellen im Quelltext. Verlassen
'kann man sich aber nur auf die Stelle, aus der heraus er auch im
'Browser für uns sichtbar gemacht wird. Das ist ein Link. Dieser
'befindet sich in einem div-Tag, das wir eindeutig über die CSS-Klasse
'"h4 panel__title" identifizieren können
Set nodeFirmenName = htmlDocument.getElementsByClassName("h4 panel__title")(0)
If Not nodeFirmenName Is Nothing Then
firmenName = Trim(nodeFirmenName.innertext)
End If
'Aufräumen:
Set nodeFirmenName = Nothing
'Der Rückgabewert ist der ausgelesene Firmenname. Wurde kein Firmenname
'ausgelesen wird eine leere Zeichenkette zurückgegeben
FirmenNameHolen = firmenName
End Function
Private Function InternetAdresseHolen(htmlDocument As Object) As String
Dim nodeAdressenContainer As Object
Dim nodeInternetAdresse As Object
Dim internetAdresse As String
'Der Link steht im ersten a-Tag des ul-Tags mit der CSS-Klasse
'"panel-bar panel-bar--address" Wir müssen die nacheinander holen,
'weil unbekannt ist, ob es immer eine Adresse und Internet Adresse
'gibt
Set nodeAdressenContainer = _
htmlDocument.getElementsByClassName("panel-bar panel-bar--address")(0)
If Not nodeAdressenContainer Is Nothing Then
'Auf den Link zugreifen
Set nodeInternetAdresse = nodeAdressenContainer.getElementsByTagName("a")(0)
If Not nodeInternetAdresse Is Nothing Then
internetAdresse = Trim(nodeInternetAdresse.innertext)
End If
End If
'Aufräumen:
Set nodeAdressenContainer = Nothing
Set nodeInternetAdresse = Nothing
'Der Rückgabewert ist der ausgelesene Firmenname. Wurde kein Firmenname
'ausgelesen wird eine leere Zeichenkette zurückgegeben
InternetAdresseHolen = internetAdresse
End Function
Private Function FirmenInfoHolen(htmlDocument As Object) As String
Dim nodeFirmenInfo As Object
Dim firmenInfo As String
'Wenn vorhanden, steht der Text in einem p-Tag mit der CSS-Klasse
'"panel__description hidden-xs"
Set nodeFirmenInfo = htmlDocument.getElementsByClassName("panel__description hidden-xs")(0)
If Not nodeFirmenInfo Is Nothing Then
firmenInfo = Trim(nodeFirmenInfo.innertext)
End If
'Aufräumen:
Set nodeFirmenInfo = Nothing
'Der Rückgabewert ist der ausgelesene text zur Firmeninfo. Wurde kein Text
'ausgelesen wird eine leere Zeichenkette zurückgegeben
FirmenInfoHolen = firmenInfo
End Function
Private Function ZertifizierungenHolen(htmlDocument As Object) As String
Dim nodeUl As Object
Dim nodeLi As Object
Dim nodeA As Object
Dim hilfsBrowser As Object
Dim nodeAlleZertifizierungen As Object
Dim nodeEineZertifizierung As Object
Dim zertifizierungenHTML As String
Dim zertifizierungen As String
'Die Zertifizierungen werden auf der Seite als mouseOver PopUp angezeigt. Sie stehen
'in einem a-Tag, welches widerum in einem li-Tag mit der CSS-Klasse "hidden-xs hidden-sm"
'liegt, das in einem ul-Tag mit der CSS-Klasse "panel-bar panel-bar--qualifier" liegt
'Das a-Tag hat unter anderem ein Attribut "data-tippy-content". Der Wert dieses
'Attributes ist ein Stück HTML, in dem die Zertifizierungen hinterlegt sind
'Problem:
'Der Wert eines Attributs ist reiner Text und kein DOM-Objekt. Deshalb bedienen wir uns
'eines kleinen Tricks und machen ein DOM-Objekt draus, damit wir bequem an die Liste
'der Zertifizierungen kommen können
Set nodeUl = htmlDocument.getElementsByClassName("panel-bar panel-bar--qualifier")(0)
If Not nodeUl Is Nothing Then
Set nodeLi = nodeUl.getElementsByClassName("hidden-xs hidden-sm")(0)
If Not nodeLi Is Nothing Then
Set nodeA = nodeLi.getElementsByTagName("a")(0)
If Not nodeA Is Nothing Then
If nodeA.hasAttribute("data-tippy-content") Then
zertifizierungenHTML = nodeA.getAttribute("data-tippy-content")
End If
End If
End If
End If
'Wenn der HTML-Part ausgelesen werden konnte
If Len(zertifizierungenHTML) > 0 Then
'Erzeugen eines HTML Objekts aus dem String über den IE
Set hilfsBrowser = CreateObject("internetexplorer.application")
hilfsBrowser.Visible = False
hilfsBrowser.navigate "about:blank"
Do Until hilfsBrowser.ReadyState = 4: DoEvents: Loop
hilfsBrowser.document.Write (zertifizierungenHTML)
'In den li-Tags stehen die Zertifizierungen
Set nodeAlleZertifizierungen = hilfsBrowser.document.getElementsByTagName("li")
'Alle Zertifizierungen auslesen
For Each nodeEineZertifizierung In nodeAlleZertifizierungen
zertifizierungen = zertifizierungen & nodeEineZertifizierung.innertext & Chr(10)
Next nodeEineZertifizierung
'Letzten Zeilenumbruch wieder aus dem String entfernen
zertifizierungen = Left(zertifizierungen, Len(zertifizierungen) - 1)
'Aufräumen:
hilfsBrowser.Quit
Set hilfsBrowser = Nothing
Set nodeAlleZertifizierungen = Nothing
Set nodeEineZertifizierung = Nothing
End If
'Aufräumen:
Set nodeUl = Nothing
Set nodeLi = Nothing
Set nodeA = Nothing
'Der Rückgabewert sind die ausgelesenen Zertifizierungen. Wurden keine
'Zertifizierungen ausgelesen wird eine leere Zeichenkette zurückgegeben
ZertifizierungenHolen = zertifizierungen
End Function
Private Function AnbieterArtHolen(htmlDocument As Object) As String
'Dim nodeUiEins As Object
Dim nodeUi As Object
Dim nodeAlleLi As Object
Dim nodeEinLi As Object
Dim ergebnis As String
'Diese Funktion erzeugt einen Ergebnisstring, dessem Aufbau durch ein b
'angiebt, ob eine Angebotsart nicht gesetzt ist und durch ein b, ob eine
'Angebotsart gesetzt ist. Wenn eine Angebotsart gesetzt ist, kann das
'an der verwendeten CSS-Klasse "is-active" in li-Tags erkannt werden,
'die in einem ul-Tag mit der CSS-Klasse "panel-bar__services services-bar"
'liegen. Da das Auslesen eines Attributs auf HTML-Strukturen nicht
'funktioniert, gehen wir über Texterkennung
Set nodeUi = htmlDocument.getElementsByClassName("panel-bar__services services-bar")(0)
If Not nodeUi Is Nothing Then
Set nodeAlleLi = nodeUi.getElementsByTagName("li")
If Not nodeAlleLi Is Nothing Then
For Each nodeEinLi In nodeAlleLi
If InStr(1, nodeEinLi.outerHTML, "is-active") > 0 Then
ergebnis = ergebnis & "a"
Else
ergebnis = ergebnis & "b"
End If
Next nodeEinLi
End If
End If
'Aufräumen:
Set nodeUi = Nothing
Set nodeAlleLi = Nothing
Set nodeEinLi = Nothing
'Der Rückgabewert ist die Zeichenkette aus 0en und 1en
AnbieterArtHolen = ergebnis
End Function
Private Function DetailUrlHolen(htmlDocument As Object) As String
Dim nodeDiv As Object
Dim nodeDetailURL As Object
Dim detailURL As String
'Der Firmendetail-URL im gleichen a-Tag, aus dem wir den Firmennamen
'ausgelesen haben. Dieser befindet sich in einem div-Tag, das wir
'eindeutig über die CSS-Klasse "h4 panel__title" identifizieren können
Set nodeDiv = htmlDocument.getElementsByClassName("h4 panel__title")(0)
If Not nodeDiv Is Nothing Then
Set nodeDetailURL = htmlDocument.getElementsByTagName("a")(0)
If Not nodeDetailURL Is Nothing Then
detailURL = nodeDetailURL.href
End If
End If
'Aufräumen:
Set nodeDiv = Nothing
Set nodeDetailURL = Nothing
'Der Rückgabewert ist der ausgelesene Firmenname. Wurde kein Firmenname
'ausgelesen wird eine leere Zeichenkette zurückgegeben
DetailUrlHolen = detailURL
End Function
Private Function AdresseHolen(htmlDocument As Object) As String
Dim nodeAdresse As Object
Dim adresse As String
Dim splitArray() As String
'Die Adresse steht in einem span-Tag mit der ID "business-card__address"
On Error Resume Next
Set nodeAdresse = htmlDocument.getElementByID("business-card__address")
On Error GoTo 0
If Not nodeAdresse Is Nothing Then
'Adresszeichenkette auslesen
adresse = Trim(nodeAdresse.innertext)
'Straße mit Hausnummer und PLZ mit Ort werden durch ein Komma getrennt
'Das nutzen wir aus, um Straße und Ort auf zwei Zeilen aufzuteilen
splitArray = Split(adresse, ",")
adresse = Trim(splitArray(0)) & Chr(10) & Trim(splitArray(1))
End If
'Der Rückgabewert ist die ausgelesene und aufbereitete Firmenanschrift
'Wurde kein Firmenname ausgelesen wird eine leere Zeichenkette zurückgegeben
AdresseHolen = adresse
End Function
Private Function EmailHolen(htmlDocument As Object) As String
Dim nodeA As Object
Dim nodeEmail As Object
Dim eMail As String
'Die E-Mail Adresse steht im einzigen span-Tag in einem a-Tag mit der ID
'"links__email"
On Error Resume Next
Set nodeA = htmlDocument.getElementByID("links__email")
On Error GoTo 0
If Not nodeA Is Nothing Then
Set nodeEmail = nodeA.getElementsByTagName("span")(0)
If Not nodeEmail Is Nothing Then
eMail = Trim(nodeEmail.innertext)
End If
End If
'Der Rückgabewert ist die ausgelesene und aufbereitete Firmenanschrift
'Wurde kein Firmenname ausgelesen wird eine leere Zeichenkette zurückgegeben
EmailHolen = eMail
End Function