So gehts mit 6 Zugriffen ;-)
26.11.2018 03:56:51
Zwenn
Hallo Patrick,
bei jeder Seite versuche ich die maximal angezeigten Treffer pro Seite nach oben zu manipulieren. Diese ist die erste bei der das funktioniert. Im Standard gehen maxiaml 100 Treffer, was für Dein Vorhaben 1.066 Zugriffe bedeuten würde. Das geht sicher auch, aber viel schöner ist es doch, wenn man den Zähler auf 20.000 schrauben kann ;-)
So kommst Du an Deine Werte. Die Preise musst Du noch so formatieren bzw. verarbeiten, dass dabei raus kommt, was Du willst. Der Internet Explorer kann auch ausgeblendet werden, wenn Du willst:
Sub StockListHolen()
'Voll viele URL Bestandteile,
'weil die URL ist echt lang
Dim url1 As String
Dim url2 As String
Dim url3 As String
Dim url4 As String
Dim url5 As String
Dim url6 As String
Dim url7 As String
Dim url8 As String
Dim url9 As String
Dim url10 As String
Dim url11 As String
Dim url12 As String
Dim url13 As String
Dim url14 As String
Dim url15 As String
Dim url16 As String
Dim url17 As String
Dim url18 As String
Dim url19 As String
Dim url20 As String
Dim url21 As String
Dim url22 As String
Dim url23 As String
Dim url24 As String
Dim urlParameterSeite As String
Dim urlSuchSeite As Long
Dim urlParameterTreffer As String
Dim urlTrefferProSeite As String
'Variablen fürs DOM (Document Object Model)
Dim browser As Object
Dim knotenWerte As Object
Dim knotenZelle As Object
Dim knotenEnde As Object
Dim urlStatisch As String
Dim urlGesamt As String
'Sonstige
Dim aktuellerWert As Long
Dim aktuelleZeile As Long
Dim aktuelleSpalte As Byte
Dim ende As Boolean
'URL Bestandteile zur Vermeidung von Zeilenumbrüchen im Forum
'(Die ganze URL geht ansonsten auch als eine String-Variable,
'außer die Such-Seite und die angezeigten Treffer pro Seite)
url1 = "https://www.gurufocus.com/stock_list.php"
url2 = "?m_country[]=USA&m_country[]=$OTCPK&m_country[]=$GREY&m_country[]="
url3 = "$NAS&m_country[]=$NYSE&m_country[]=$ARCA&m_country[]=$OTCBB&m_country[]="
url4 = "$AMEX&m_country[]=$BATS&m_country[]=$IEXG&m_country[]=CAN&m_country[]="
url5 = "$TSXV&m_country[]=$TSX&m_country[]=$XCNQ&m_country[]=$NEOE&m_country[]="
url6 = "_UK&m_country[]=GBR&m_country[]=_Europe&m_country[]=DEU&m_country[]="
url7 = "FRA&m_country[]=POL&m_country[]=RUS&m_country[]=SWE&m_country[]=TUR&m_country[]="
url8 = "BIH&m_country[]=ITA&m_country[]=LUX&m_country[]=CHE&m_country[]=BEL&m_country[]="
url9 = "GRC&m_country[]=NOR&m_country[]=ESP&m_country[]=DNK&m_country[]=BGR&m_country[]="
url10 = "NLD&m_country[]=ROU&m_country[]=FIN&m_country[]=SRB&m_country[]=AUT&m_country[]="
url11 = "HRV&m_country[]=PRT&m_country[]=SVK&m_country[]=CYP&m_country[]=MKD&m_country[]="
url12 = "SVN&m_country[]=UKR&m_country[]=HUN&m_country[]=LTU&m_country[]=LVA&m_country[]="
url13 = "MLT&m_country[]=ISL&m_country[]=EST&m_country[]=CZE&m_country[]="
url14 = "_Asia&m_country[]=JPN&m_country[]=KOR&m_country[]=THA&m_country[]="
url15 = "HKG&m_country[]=CHN&m_country[]=TWN&m_country[]=MYS&m_country[]=SGP&m_country[]="
url16 = "ISR&m_country[]=IDN&m_country[]=VNM&m_country[]=PHL&m_country[]=LKA&m_country[]="
url17 = "BGD&m_country[]=KWT&m_country[]=NPL&m_country[]=SAU&m_country[]=JOR&m_country[]="
url18 = "OMN&m_country[]=IRN&m_country[]=IRQ&m_country[]=ARE&m_country[]=KAZ&m_country[]="
url19 = "BAH&m_country[]=_Oceania&m_country[]=AUS&m_country[]=NZL&m_country[]="
url20 = "_SA&m_country[]=BRA&m_country[]=MEX&m_country[]=ARG&m_country[]=CHL&m_country[]="
url21 = "PER&m_country[]=COL&m_country[]=JAM&m_country[]=VEN&m_country[]=ECU&m_country[]="
url22 = "_Africa&m_country[]=ZAF&m_country[]=EGY&m_country[]=NGA&m_country[]="
url23 = "MUS&m_country[]=MAR&m_country[]=ZWE&m_country[]=KEN&m_country[]=TUN&m_country[]="
url24 = "GHA&m_country[]=CIV&m_country[]=_India&m_country[]=IND&m_country[]=PAK"
'Seiten und Treffer Handling
urlParameterSeite = "&p="
urlSuchSeite = 0 'Erste Seite ist mit 0 nummeriert
urlParameterTreffer = "&n="
'Die angezeigten Treffer pro Seite sind theoretisch beliebig manipulierbar.
'Bei 20.000 hat der HTML Quelltext 12,1 MB Text und ist auf meinem Rechner
'die Grenze des Erträglichen. Es dauert einigermaßen lange, diese Menge
'an Informationen zu verarbeiten. Aber so müssen nur 6 Seiten geladen werden,
'statt 1.066 bei 100 Treffern pro Seite
'Zum Vergleich: Die Bibel hat als reine Text-Datei ca. 4 MB
urlTrefferProSeite = "20000"
'Teil der URL, der den ersten langen statischen Teil bildet
urlStatisch = url1 & url2 & url3 & url4 & url5 & url6 & url7 & url8 & url9 & url10 _
& url11 & url12 & url13 & url14 & url15 & url16 & url17 & url18 & url19 & url20 _
& url21 & url22 & url23 & url24 & urlParameterSeite
'Die aktuelle Zeile und Spalte zum schreiben
'in der Excel-Tabelle initialisieren
aktuelleZeile = 2
aktuelleSpalte = 1
Do
'Internet Explorer initialisiern, Sichtbarkeit festlegen,
'URL aufrufen und warten bis sie vollständig geladen wurde
Set browser = CreateObject("InternetExplorer.Application")
browser.Visible = True
browser.navigate urlStatisch & urlSuchSeite & urlParameterTreffer & urlTrefferProSeite
Do While browser.readyState 4: DoEvents: Loop
'Auf Seite ohne Werte prüfen
'(Makro Ende, da keine Werte auszulesen sind)
Set knotenEnde = browser.document.getElementsByClassName("info")(0)
'Auf das Ergebnis des Letzte-Seite-Tests reagieren
If Not knotenEnde Is Nothing Then
If knotenEnde.innertext = "No stocks found." Then
'Letzte Seite wurde eingelesen
ende = True
End If
End If
If ende = False Then
'Direkt die relevanten Tabellenzellen der geladenen Seite in ein Array einlesen
Set knotenWerte = browser.document.getElementByID("R1").getElementsByTagName("td")
'Set knotenWerte = knotenTabelle.getElementsByTagName("td")
'Zellen-Zähler initialisieren
aktuellerWert = 1
'Alle Zellen durchgehen und gewünschte Werte in Excel-Tabelle schreiben
For Each knotenZelle In knotenWerte
'Zelle 1 = Symbol, Zelle 2 = Company, Zelle 3 = Price
'Zelle 4 ist irrelevant und dient hier als Zeilenwechsel
If aktuellerWert Mod 4 0 Then
'Wert in die aktuelle Zelle schreiben
Cells(aktuelleZeile, aktuelleSpalte).Value = knotenZelle.innertext
'Nächste Spalte
aktuelleSpalte = aktuelleSpalte + 1
Else
'Nächste Zeile
aktuelleZeile = aktuelleZeile + 1
'Spalte zurücksetzen
aktuelleSpalte = 1
End If
'Anzahl der Abzuarbeitenden Werte um 1 hochzählen
aktuellerWert = aktuellerWert + 1
Next knotenZelle
'Nächste Seite
urlSuchSeite = urlSuchSeite + 1
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenWerte = Nothing
Set knotenZelle = Nothing
Loop Until ende
Set knotenEnde = Nothing
MsgBox "Fertig"
End Sub
Viele Grüße,
Zwenn