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
|