habe unten stehendes Makro, welches beim Öffnen der Datei gestartet wird.
Jedesmal kommt nach einer gewissen Zeit, wenn das Makro 2 gestartet wird, die Meldung
Index außerhalb des gültigen Bereichs und beim Debuggen wird die Zeile
Set Internet = CreateObject("InternetExplorer.Application") im Makro 2 markiert.
Interessanterweise, wenn ich das Makro beende und im Anschluss dann händig das Makro1 starte, kommt keine Fehlermeldung mehr.
Was kann ich machen, dass es künftig auch beim ersten mal funktioniert?
Eine Beispielmappe möchte ich ungerne hochladen, da das Ganze nur miti den Koordinaten meines Hauses sinnvolle und nachvollziehbare Ergebnisse bringt, mit denen man auch die Funktionen der Mappe nachvollziehen kann.
Damals als ich diese Mappe erstellt hatte, gab es ein Versuch von Günther die Daten mittels Powerquery herunterzuladen, damals zumindest ist es laut Günther an dem Aufbau/ der Programmierung der Internetseite gescheitert, sodass ich auf eine Makrolösung ausgewichen bin.
Hier die Makros:
Sub Makro1()
'1. Internetseite laden
Sheets("Tabelle1").Select
Columns("I:I").Select
Selection.Replace What:="Tabelle2!", Replacement:="Tabelle3!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Tabelle2").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Tabelle3").Select
Sheets.Add
ActiveSheet.Name = "Tabelle2"
Sheets("Tabelle3").Select
Dim Internet As Object
Set Internet = CreateObject("InternetExplorer.Application")
Internet.Navigate [a1]
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Visible = True
Internet.execwb 17, 0
Internet.execwb 12, 0
Internet.execwb 18, 0
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Quit
Set Internet = Nothing
Sheets("Tabelle2").Select
Range("a1").Select
Sheets("Tabelle2").Paste
Application.OnTime Now + TimeValue("00:00:25"), "Makro2"
End Sub
------------------------------------------------------------------------------------------------ _ --
Sub Makro2()
'2. Internetseite laden
Sheets("Tabelle2").Select
Range("a6000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(3, 0).Select
Sheets("Tabelle3").Select
Dim Internet As Object
Set Internet = CreateObject("InternetExplorer.Application")
On Error GoTo 0
Internet.Navigate [a2]
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Visible = True
Internet.execwb 17, 0
Internet.execwb 12, 0
Internet.execwb 18, 0
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Quit
Set Internet = Nothing
Sheets("Tabelle2").Select
Sheets("Tabelle2").Paste
Sheets("Tabelle1").Select
Columns("I:I").Select
Selection.Replace What:="Tabelle3!", Replacement:="Tabelle2!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("a1").Select
End Sub
------------------------------------------------------------------------------------------------ _
--
Sub Makro3()
' Makro3 Makro
Columns("I:I").Select
Selection.Replace What:="Tabelle3!", Replacement:="Tabelle2!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
------------------------------------------------------------------------------------------------ _
-----------------
Sub Makro4()
Application.OnTime TimeValue("00:00:00")
Makro1
Application.OnTime Now + TimeValue("01:00:00")
Makro1
End Sub