Sub StepStoneJobsAuslesen()
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
currentRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set jobOfferUrlDict = CreateObject("Scripting.Dictionary")
jobOfferUrlDict.CompareMode = vbTextCompare
For fillDictRow = 2 To currentRow - 1
If ActiveSheet.Cells(fillDictRow, 2).Hyperlinks.Count = 1 Then
cellUrl = ActiveSheet.Cells(fillDictRow, 2).Hyperlinks(1).Address
jobOfferUrlDict(cellUrl) = cellUrl
End If
Next fillDictRow
urlSearchTerm = "Entwickler"
urlSearchTermClear = PrepareSearchTerm(urlSearchTerm)
url = baseUrl & urlSearchTermClear
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
Do
Set nodeJobOfferContainer = browser.document.getElementsByClassName("gvBCse")(0)
If Not nodeJobOfferContainer Is Nothing Then
Set nodeAllJobOffers = nodeJobOfferContainer.getElementsByClassName("fKQtCB")
For Each nodeOneJobOffer In nodeAllJobOffers
jobOfferUrl = nodeOneJobOffer.getElementsByClassName("gzNLsV")(0).href
questionMarkIndex = InStr(1, jobOfferUrl, "?")
If questionMarkIndex > 0 Then
urlLengthLeft = Len(jobOfferUrl) - ((Len(jobOfferUrl) - questionMarkIndex) + 1)
jobOfferUrl = Left(jobOfferUrl, urlLengthLeft)
End If
If Not jobOfferUrlDict.Exists(jobOfferUrl) Then
If currentRow > 14 Then
ActiveWindow.SmallScroll down:=1
End If
jobOfferUrlDict(jobOfferUrl) = jobOfferUrl
ActiveSheet.Cells(currentRow, 1).Value = urlSearchTerm
jobOfferTitle = Trim(nodeOneJobOffer.getElementsByClassName("iHAUBO")(0).innertext)
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(currentRow, 2), Address:=jobOfferUrl, TextToDisplay:=jobOfferTitle
ActiveSheet.Cells(currentRow, 3).Value = Int(Now)
ActiveSheet.Cells(currentRow, 4).Value = Now() - Int(Now)
currentRow = currentRow + 1
End If
Next nodeOneJobOffer
Set nodeNextButton = browser.document.getElementsByClassName("euFwQt")(0)
If Not nodeNextButton Is Nothing Then
nodeNextButton.Click
Application.Wait (Now + TimeSerial(0, 0, 3))
nextPagePossible = True
Else
nextPagePossible = False
End If
Else
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)
currentRow = currentRow + 1
nextPagePossible = False
End If
Loop While nextPagePossible
browser.Quit
Set browser = Nothing
Set nodeJobOfferContainer = Nothing
Set nodeAllJobOffers = Nothing
Set nodeOneJobOffer = Nothing
End Sub