Thema Datum  Von Nutzer Rating
Antwort
27.05.2020 18:40:06 T
NotSolved
27.05.2020 18:55:01 Gast7155
NotSolved
27.05.2020 19:00:43 T
NotSolved
27.05.2020 19:05:56 Gast88570
NotSolved
27.05.2020 19:17:27 Gast2666
NotSolved
27.05.2020 20:02:55 T.
NotSolved
27.05.2020 22:29:51 Gast2666
NotSolved
27.05.2020 22:52:03 Zwenn
*****
NotSolved
28.05.2020 07:17:40 T.
NotSolved
28.05.2020 07:35:21 T.
NotSolved
28.05.2020 10:35:43 Zwenn
NotSolved
28.05.2020 10:55:16 T.
NotSolved
Rot Sehr gezielt geht es dann so
28.05.2020 23:48:23 Zwenn
*****
NotSolved
29.05.2020 12:02:29 T.
NotSolved
03.06.2020 11:04:07 T.
NotSolved
03.06.2020 18:40:47 T.
NotSolved
04.06.2020 10:15:34 Gast60463
NotSolved
04.06.2020 10:17:24 Gast97475
NotSolved
04.06.2020 10:19:15 Gast27513
NotSolved
04.06.2020 10:21:06 Zwenn
NotSolved

Ansicht des Beitrags:
Von:
Zwenn
Datum:
28.05.2020 23:48:23
Views:
734
Rating: Antwort:
  Ja
Thema:
Sehr gezielt geht es dann so

Hallo T.

Ich habe da mal was gebastelt ;-) Bitte die Kommentare im Makro aufmerksam lesen. Ich habe Dir schon die Schleife vorbereitet, um mehrere Suchbegriffe abzuarbeiten. Da musst Du aber noch etwas nacharbeiten. Für den Vergleich auf doppelte Jobangebote (ja, ist notwendig) habe ich mirr ein paar mehr graue Haare eingehandelt. Wer ahnt denn, dass StepStone irgendwelche individuellen blöden IDs in die URL schreibt, die man nicht braucht? ;-)

Ok, Rockn Roll. Was Du sonst noch brauchst, wirst Du hinbekommen denke ich^^

Das eigentliche Makro:

Sub StepStoneJobsAuslesen()

'*************************************************************
'Das Makro schreibt ab der ersten freien Zeile in die Tabelle,
'aus der es gestartet wird. Die Kopfzeile wird ignoriert
'*************************************************************

'Es sind 3 Parameter notwendig:
'Die Reihenfolge von URL-Parametern ist egal
'Deshalb nimmt man die Konstanten nach vorne
'Der erste URL-Parameter/ die Parameterliste wird mit dem Fragezeichen eingeleitet (?)
'Jeder weitere Parameter wird mit dem Kaufmanns-Und abgetrennt (&)
'li=100   [Setzt die Anzahl der Suchtreffer pro Seite auf 100. Mehr geht nicht]
'ex=90002 [Filtert die Suchergebnisse auf "Mit Berufserfahrung]
'ke=      [Hinter dem Parameternamen ke kommt der Suchterm. Der ist dynamisch]
Const baseUrl As String = "https://www.stepstone.de/5/ergebnisliste.html?li=100&ex=90002&ke="

Dim browser As Object
Dim url As String
Dim urlSearchTerm As String
Dim urlSearchTermClear As String
Dim nodeJobOfferContainer As Object
Dim nodeAllJobOffers As Object
Dim nodeOneJobOffer As Object
Dim nodeNextButton As Object

Dim currentRow As Long
Dim jobOfferTitle As String
Dim jobOfferUrl As String
Dim nextPagePossible As Boolean
Dim jobOfferUrlDict As Object
Dim cellUrl As String
Dim fillDictRow As Long
Dim questionMarkIndex As Long
Dim urlLengthLeft As Long
  
  'Erste freie Zeile anhand von Spalte A in der aktiven Tabelle feststellen
  currentRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
  
  'Scripting-Dictionary einrichten für schnelle Prüfung auf doppelte Jobangebote
  'Diese lassen sich am Link erkennen und im Dectionary leicht über Exists() prüfen
  Set jobOfferUrlDict = CreateObject("Scripting.Dictionary")
  'Case Sensitive für Exists() abschalten
  jobOfferUrlDict.CompareMode = vbTextCompare
  
  'In der Tabelle vorhandene Links ins Dictionary aufnehmen
  'So werden später durchgeführte Makroläufe mit gleichen
  'Suchbegriffen möglich. Diese schreiben dann nur neue
  'Jobangebote in die Tabelle
  '
  'Achtung:
  'Werden die Spaltenzuordnungen verändert, muss das hier
  'angepasst werden. Das Makro geht von URLs in Spalte B aus
  For fillDictRow = 2 To currentRow - 1
    'Falls es Suchtbegriffe ohne Treffer gab, gibt es evtl.
    'Zeilen ohne URL. Die müssen übersprungen werden
    If ActiveSheet.Cells(fillDictRow, 2).Hyperlinks.Count = 1 Then
      'Hyperlink in Dictionary aufnehmen und überflüssiges Value setzen
      'Wir brauchen das Dictionary zum schnellen Abgleich doppelter URLs
      'über die Exists() Methode. Die URLs werden dafür als Keys gesetzt
      cellUrl = ActiveSheet.Cells(fillDictRow, 2).Hyperlinks(1).Address
      jobOfferUrlDict(cellUrl) = cellUrl
    End If
  Next fillDictRow
  
  'Dynamisierung für mehrere Suchbegriffe gehört ab hier in eine Schleife
  'Die lasse ich jetzt weg, weil die nur im Zusammenhang mit mehreren
  'abzuarbeitenden Suchbegriffen in einer Tabelle Sinn macht
  'Deshalb wird hier mit folgenden statischen Suchbegriff zum Testen gearbeitet
  '
  'Variablendeklarationen und Initialisierung für die Schleife fehlen noch
  'For currentRowSearchTerms = startRow to endRow
    'Test-Suchbegriffe
    'urlSearchTerm = "abb ag" 'Weniger als 100 Suchtreffer = 1 Seite
    urlSearchTerm = "Entwickler" 'Mehr als 100 Suchtreffer = >1 Seite
    'urlSearchTerm = "Mazars Advisors GmbH & Co. KG" 'Suchbegriff mit in URL verbotenem Sonderzeichen
    '
    'Bei Aktivierung der Suchterm-Schleife, alle Test-Suchbegriffe auskommentieren
    'Nächster Suchbegriff bei Abarbeitung mehrerer aus einer Tabelle
    'urlSearchTerm = Sheets("SuchTermTabelle-ANPASSEN").Cells(currentRowSearchTerms, 1).Value
    
    'In URL verbotene Sonderzeichen werden automatisiert ersetzt
    urlSearchTermClear = PrepareSearchTerm(urlSearchTerm)
    
    'Es ergibt sich die ganze URL
    url = baseUrl & urlSearchTermClear
    
    'Internet Explorer initialisieren, Sichtbarkeit festlegen,
    'URL aufrufen und warten bis Seite vollständig geladen wurde
    Set browser = CreateObject("internetexplorer.application")
    browser.Visible = True
    browser.navigate url
    Do Until browser.readyState = 4: DoEvents: Loop
    
    'Schleife zum Durchgehen der Paginierung
    '(Aller Seiten mit Suchergebnissen zum Suchbegriff)
    'Paginierung ist der Fachbegriff, der auch oft im HTML Code zu finden ist)
    'Eine Seite gibt es auf jeden Fall, deshalb eine Fußgesteuerte Schleife
    Do
      'Versuchen, den Container mit den Jobangeboten zu separieren
      Set nodeJobOfferContainer = browser.document.getElementsByClassName("gvBCse")(0)
      
      'Weiter, wenn es Suchtreffer gibt
      If Not nodeJobOfferContainer Is Nothing Then
        'Alle Jobangebote in eine NodeList schreiben
        Set nodeAllJobOffers = nodeJobOfferContainer.getElementsByClassName("fKQtCB")
        
        'Alle Jobangebote durchgehen und in die aktive Tabelle schreiben
        For Each nodeOneJobOffer In nodeAllJobOffers
          'URL des Jobangebots auslesen
          jobOfferUrl = nodeOneJobOffer.getElementsByClassName("gzNLsV")(0).href
          
          'Die Parameterliste der URL entfernen. Denn der Parameter "suid" hat immer
          'einen anderen Wert. Deshalb gibt es nie gleiche URLs mit dem Parameter
          '"suid", die sich für unsere Zwecke als solche erkennen lassen. Es gibt
          'den weiteren Parameter rltr, der aber auch einfach weggelassen werden kann
          'Das Jobangebot lässt sich trotzdem durch anklicken des Links in der Tabelle
          'aufrufen
          '
          'Index des Fragezeichens finden (leitet die Parameterliste ein)
          questionMarkIndex = InStr(1, jobOfferUrl, "?")
          
          'Sicher gehen, dass es eine Parameterliste gibt
          If questionMarkIndex > 0 Then
            'Länge der zu löschenden Parameterliste
            urlLengthLeft = Len(jobOfferUrl) - ((Len(jobOfferUrl) - questionMarkIndex) + 1)
            
            'Zu löschende Parameterliste
            jobOfferUrl = Left(jobOfferUrl, urlLengthLeft)
          End If
          
          'Wenn es den Link noch nicht in der Tabelle gibt,
          'ins Dictionary und die Tabelle eintragen
          If Not jobOfferUrlDict.Exists(jobOfferUrl) Then
            'Mitscrollen zur Sichtkontrolle ab Zeile 15
            If currentRow > 14 Then
              ActiveWindow.SmallScroll down:=1
            End If

            'Eintrag ins Dictionary und mit Value als gleichen Wert
            '(Value ist hier überflüssig, muss aber gesetzt werden
            ' Wir wollen nur die Exists() Methode ausnutzen, die auf
            ' den Key prüft)
            jobOfferUrlDict(jobOfferUrl) = jobOfferUrl
            
            'Eintrag in die Tabelle
            '
            'Suchterm in Spalte A eintragen
            'Bei mehreren Firmen ist die Zuordnung damit automatisch gegeben
            ActiveSheet.Cells(currentRow, 1).Value = urlSearchTerm
            
            'Titel des Jobangebots auslesen
            jobOfferTitle = Trim(nodeOneJobOffer.getElementsByClassName("iHAUBO")(0).innertext)
            
            'Titel als Link in die Tabelle schreiben
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(currentRow, 2), Address:=jobOfferUrl, TextToDisplay:=jobOfferTitle
            
            'Datum und Uhrzeit eintragen (Spalten entsprechend Formatieren)
            ActiveSheet.Cells(currentRow, 3).Value = Int(Now)
            ActiveSheet.Cells(currentRow, 4).Value = Now() - Int(Now)
            
            'Nächste Zeile vorbereiten
            currentRow = currentRow + 1
          End If
        Next nodeOneJobOffer
        
        'Prüfen, ob es eine weitere Seite mit Suchtreffern gibt
        'Versuchen den Weiter-Button zu separieren
        Set nodeNextButton = browser.document.getElementsByClassName("euFwQt")(0)
        
        'Prüfen, ob er gefunden wurde
        If Not nodeNextButton Is Nothing Then
          'Anklicken
          nodeNextButton.Click
          
          'Manuelle Pause zum Seite laden
          'Die drei hinteren Werte sind Stunden, Minuten, Sekunden
          '(Evtl. anpassen. Ist aber reiner Zeitfaktor, da doppelte
          ' Treffer in der Tabelle, oben verhindert werden)
          Application.Wait (Now + TimeSerial(0, 0, 3))
          
          'Es gibt eine weitere Suchseite
          nextPagePossible = True
        Else
          'Ende der Paginierung erreicht
          nextPagePossible = False
        End If
      Else
        'Suchterm, Keine-Treffer-Meldung und Zeitstempel in die Tabelle schreiben
        '
        'Suchterm in Spalte A eintragen
        'Bei mehreren Firmen ist die Zuordnung damit automatisch gegeben
        ActiveSheet.Cells(currentRow, 1).Value = urlSearchTerm
        ActiveSheet.Cells(currentRow, 2).Value = "keine Suchergebnisse"
        ActiveSheet.Cells(currentRow, 3).Value = Int(Now)
        ActiveSheet.Cells(currentRow, 4).Value = Now() - Int(Now)
        
        'Nächste Zeile vorbereiten
        '(Wichtig sobald mehrere Suchbegriffe in einer Schleife abgearbeitet werden)
        currentRow = currentRow + 1
        
        'Es gibt keine Seite zum durchblättern
        '(Wichtig sobald mehrere Suchbegriffe in einer Schleife abgearbeitet werden)
        nextPagePossible = False
      End If
    Loop While nextPagePossible
    
    'Aufräumen
    browser.Quit
    Set browser = Nothing
    Set nodeJobOfferContainer = Nothing
    Set nodeAllJobOffers = Nothing
    Set nodeOneJobOffer = Nothing
  'Hier endet die Schleife bei Abarbeitung mehrerer Suchbegriffe
  'next currentRowSearchTerms
End Sub

Die Funktion zum Umwandeln unerlaubter Zeichen in einer URL, in URL-Codierung. Keine Ahnung ob die Zeichen vollständig sind. Kann man aber ggf. leicht erweitern. Kommt aus einem Amazon Projekt, habe ich einfach 1 zu 1 übernommen:

Function PrepareSearchTerm(rawSearchTerm As String) As String

Dim searchTerm As String
  'Die Codierung der Zeichen muss in einer
  'bestimmten Reihenfolge ablaufen. Sonst
  'werden die Codes schon codierter Zeichen
  'ggf. teilweise überschrieben
  
  'Alle Zeichen, die in einer URL verboten
  'sind durch URL-Codierung ersetzen
  searchTerm = Replace(rawSearchTerm, "%", "%25")
  searchTerm = Replace(searchTerm, "?", "%3F")
  searchTerm = Replace(searchTerm, "&", "%26")
  searchTerm = Replace(searchTerm, "#", "%23")
  searchTerm = Replace(searchTerm, "/", "%2F")
  searchTerm = Replace(searchTerm, "$", "%24")
  searchTerm = Replace(searchTerm, "+", "%2B")
  searchTerm = Replace(searchTerm, ":", "%3A")
  searchTerm = Replace(searchTerm, ";", "%3B")
  searchTerm = Replace(searchTerm, "=", "%3D")
  searchTerm = Replace(searchTerm, "@", "%40")
  
  'Das Komma wird von Amazon ungewöhnlich codiert
  searchTerm = Replace(searchTerm, ",", "\c")
  
  'Zum Schluss alle Leerzeichen durch ein Plus ersetzen
  searchTerm = Replace(searchTerm, " ", "+")
  
  PrepareSearchTerm = searchTerm
End Function

Viele Grüße,

Zwenn


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
27.05.2020 18:40:06 T
NotSolved
27.05.2020 18:55:01 Gast7155
NotSolved
27.05.2020 19:00:43 T
NotSolved
27.05.2020 19:05:56 Gast88570
NotSolved
27.05.2020 19:17:27 Gast2666
NotSolved
27.05.2020 20:02:55 T.
NotSolved
27.05.2020 22:29:51 Gast2666
NotSolved
27.05.2020 22:52:03 Zwenn
*****
NotSolved
28.05.2020 07:17:40 T.
NotSolved
28.05.2020 07:35:21 T.
NotSolved
28.05.2020 10:35:43 Zwenn
NotSolved
28.05.2020 10:55:16 T.
NotSolved
Rot Sehr gezielt geht es dann so
28.05.2020 23:48:23 Zwenn
*****
NotSolved
29.05.2020 12:02:29 T.
NotSolved
03.06.2020 11:04:07 T.
NotSolved
03.06.2020 18:40:47 T.
NotSolved
04.06.2020 10:15:34 Gast60463
NotSolved
04.06.2020 10:17:24 Gast97475
NotSolved
04.06.2020 10:19:15 Gast27513
NotSolved
04.06.2020 10:21:06 Zwenn
NotSolved