Hallo zusammen,
mein Projekt sieht wie folgt aus. Ich habe eine Excel Liste welche diverse Hyperlink (ca. 300) enthält, nun möchte ich diese über ein Makro aufrufen und bestimmte Informationen extrahieren und in die Excel schreiben.
Mein Code funktioniert auch einwandfrei, lediglich mit der Performance (Geschwindigkeit) bin ich noch nicht zufrieden.
Wie muss der Code abgeändert werden damit eine Performacesteigerung spürbar ist. Ich dachte evt. an eine Speicherung in einem Array (Hyperlink --> wobei es auch Zeilen git bei denen kein Hyperlink hinterlegt ist) und die Infos aus dem Explorer (lange Strings) ebenfalls in einem art Array abspeichern...
Über jegliche hilfe bin ich Dankbar und nachfolgend nun der Code:
Option Explicit
Sub StelleninfosAuslesen()
Dim browser As Object
Dim nodeJobOffer As Object
Dim jobTasks As String
Dim jobProfil As String
Dim HyperlinkRow As Long
Dim Hyperlink As String
HyperlinkRow = 2
Do
'Navigation zum Hyperlink sofern es sich um einen handelt, ansonsten wird in der nächsten Zeile fortgefahren
If ActiveSheet.Cells(HyperlinkRow, 2).Hyperlinks.Count = 1 Then
Hyperlink = ActiveSheet.Cells(HyperlinkRow, 2).Hyperlinks(1).Address
Else
HyperlinkRow = HyperlinkRow + 1
End If
'Browser öffnen und laden lassen
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.navigate Hyperlink
Do Until browser.readyState = 4: DoEvents: Loop
jobTasks = Trim(browser.document.getElementsByClassName("at-section-text-description-content sc-hmzhuo")(0).innertext)
jobProfil = Trim(browser.document.getElementsByClassName("at-section-text-profile-content sc-hmzhuo")(0).innertext)
ActiveSheet.Cells(HyperlinkRow, 8).Value = jobTasks
ActiveSheet.Cells(HyperlinkRow, 9).Value = jobProfil
browser.Quit
Set browser = Nothing
jobTasks = ""
jobProfil = ""
HyperlinkRow = HyperlinkRow + 1
Loop Until IsEmpty(ActiveSheet.Cells(HyperlinkRow, 2))
End Sub
Viele Grüße
Tobi
|