VBA Schleife richtig einsetzen

Hallo,

über den gestrigen Tag habe ich mir einen Code zusammengewürfelt, der derzeit eine Website ausliest.

Nun scheitre ich dabei eine Schleife in das Makro einzufügen, sodass diese die Anweisungen für mehrere Seiten einzeln wiederholt und hoffe Ihr wisst weiter.

Das Makro sieht derzeit so aus:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub XX()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim Website As String
Dim Price As Variant

Website(0) = "https://Seite.html"  
Website(1) = "https://Seite1.html"  

Set request = CreateObject("MSXML2.XMLHTTP")  

request.Open "Get", Website, False  

request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT)"  

request.send

response = StrConv(request.responseBody, vbUnicode)

html.body.innerHTML = response

Price = html.getElementsByClassName("now")(0).innerText  

Sheets("Tabelle1").Range("A1").Value = Price  

End Sub

Wenn Ihr eine kurze Erklärung zur Lösung habt, freue mich sehr.

P.S. über die Suchfunktion habe ich bisher nicht das richtige gefunden bzw. konnte es nicht anwenden.

Vielen Dank und einen schönen Sonntag.

VG
Robin

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 521107

Url: https://administrator.de/forum/vba-schleife-richtig-einsetzen-521107.html

Ausgedruckt am: 04.04.2025 um 16:04 Uhr

4 Kommentare

Neuester Kommentar

Es dürfte einfacher sein die URL's in Zellen, z.B. Spalte A ab Zeile 2 zu schreiben.
Eine Schleife geht dann

1
2
3
for i = 2 to cells(rows.count, 1).end(xlup).row
'hier dein Code  
next i

Die Abfrage des Preises ist im Prinzip richtig, aber ohne Kenntnis des html-Codes kann man das nicht beurteilen.

Die ETag auf das Jahr 2000 zu prüfen, hat etwas.

Vielen Dank für deine schnell Antwort.

Ich hab dein Vorschlag versucht, leider gibt er mit bei der Zeile response = StrConv(request.responseBody, vbUnicode) einen Laufzeitfehler "-2147483638 | Die für diesen Vorgang erforderlichen Daten sind noch nicht verfügbar" aus. Der Code muss dann wahrscheinlich angepasst werden, da die Seite direkt geöffnet wird oder?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub XX2()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim Website As String
Dim Price As Variant

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

ActiveWorkbook.FollowHyperlink Address:=Range("a1").Text, NewWindow:=True  

Set request = CreateObject("MSXML2.XMLHTTP")  

'request.Open "Get", Website, False  

'request.send  

response = StrConv(request.responseBody, vbUnicode)

html.body.innerHTML = response

Price = html.getElementsByClassName("now")(0).innerText  

Sheets("Tabelle1").Range("A1").Value = Price  

Next i

End Sub

Das Auslesen des HTML-Codes sollte passen.

VG
Robin

eine letzte Bemerkung:
Sowohl 'request.Open als auch 'request.send sind auskommentiert.

Vielen Dank, hab es nun durch dich hinbekommen.

Hier nochmal der derzeitige Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub XXX()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim Website As String
Dim Price As Variant

For i = 0 To Cells(Rows.Count, 1).End(xlUp).Row

Website = Sheets("Tabelle1").Range("A1").Offset(1 * i, 0)  

Set request = CreateObject("MSXML2.XMLHTTP")  

request.Open "Get", Website, False  

request.send

response = StrConv(request.responseBody, vbUnicode)

html.body.innerHTML = response

Price = html.getElementsByClassName("now")(0).innerText  

Sheets("Tabelle2").Range("A1").Offset(1 * i, 0).Value = Price  

Next i

End Sub