Hey Leute,

ich habe schon mal was bezüglich zu meinem Problem gefragt aber ich komme einfach nicht zum ziel. der folgende code liest daten aus einer datei fügt diese zu einem link zusammen in dem fall das örtliche und prüft ob es das gibt oder nicht wenn ja geht er zum zum nächsten eintrag in der tabelle und prüft diesen, wenn er es nicht findet färbt er die zelle rot und geht zum nächsten usw bis er am ende der tabelle ist. dies sind über 4000 einträge die er prüfen soll die in einer schleife durchlaufen.

Option Explicit

Sub Suche()
    Dim InternetExplorer As Object
    Dim Zeile As Integer
    Dim objElement As Object
    Dim objCollection As Object
    Dim link As String
    Dim strplz As String
    Dim strname As String
    Dim i As Integer
    Dim l As Object
    Dim found As Boolean
        
    Set InternetExplorer = CreateObject("InternetExplorer.Application")
    InternetExplorer.Visible = True 'False später
    Application.StatusBar = "Das Örtliche wird geladen bitte warten..."
     
    Zeile = 1
    
neu:
    Zeile = Zeile + 1
    Do While Not IsEmpty(WorkbookQuelle.Sheets("Sheet1").Cells(Zeile, 1))
        
    strname = WorkbookQuelle.Sheets("Sheet1").Cells(Zeile, name).Value
    strplz = WorkbookQuelle.Sheets("Sheet1").Cells(Zeile, plz).Value
    

'link generien
    strname = Replace(strname, " ", "+")
    link = "http://www.dasoertliche.de/Controller?book=2239&zvo_ok=0&choose=true&context=0&action=43&ci=" & strplz & "&kw=" & strname & "&topKw=0&page=0&form_name=search_nat"
    'Suche
    InternetExplorer.navigate link
    
    Do While InternetExplorer.readystate <> 4
    Application.Wait (Now + TimeValue("00:00:01"))
    Loop
    
    Debug.Print Zeile
    
    'Weiter

'drückt das erste suchergebnis an wenn es eins gibt wenn nicht wird dies weiter unten über die if found bedingung abgefangen
    found = False
    i = 0
    Set objCollection = InternetExplorer.document.getelementsbytagname("a")
    Do While i < objCollection.Length
        If (objCollection(i).classname = "name ") Then
        Set objElement = objCollection(i)
        found = True
        Exit Do
        End If
        i = i + 1
    Loop
    

'dient nur um zu gucken ob er ein fehler hat denn wenn i = 0 ist dann hat er sich mal wieder festgefahren
    If (i = 0) Then
    MsgBox "Falscher Index i"
    Exit Sub
    End If
    
    If (found <> True) Then
        WorkbookQuelle.Sheets("Sheet1").Cells(Zeile, 1).Interior.ColorIndex = 3
        GoTo neu
    End If
    
    objElement.Click
    
    Zeile = Zeile + 1

    Loop
                
    Application.StatusBar = "Fertig"
    Set objElement = Nothing
    Set objCollection = Nothing
    InternetExplorer.Quit
    Set InternetExplorer = Nothing
End Sub

das problem an dem code ist das er die internetseiten sehr schnell lädt und dann ab der dritten abfrage anhält und nichts mehr macht im browser und das wars dann. ich verstehe einfach nicht warum das passiert. ich meine ist etwas im code falsch oder in meiner denkweise wie er das alles abarbeiet? aber er nimmt die daten setzt den link sucht den wartet mit readystate und macht dann weiter und behandelt dann dementsprechend ob er was im örtlichen findet oder nicht. aber wieso überschlägt er sich immer und geht dann nicht weiter. ist das zu schnell für ihn? wieso wartet er nicht wie er soll? ich verzweifle weil ich seit einer woche nun mehr daran rumspiele und es einfach nicht in den griff kriege.

bitte helft mir ich bin am verzweifeln

danke

gruß nils