Webabfragenschleife importiert immer selbe seite
Pascal
ich möchte meine alle meine Position in den ersten 1000 Suchtreffern regelmäßig abfragen.
Dazu verwende ich den unten angegebenen Code.
Aber aus irgendeinem Grund erscheint bei mir immer das selbe Suchergebnis. Wird da etwas gecacht, was ich erst leeren muss? Oder mache ich irgendeinen Denkfehler?
Vorab vielen Dank an Eure Hilfe,
Pascal
Sub webseite_abfragen()
Tabende_Blatt2 = Sheets("Tabelle2").Cells(Cells.Rows.Count, 2).End(xlUp).Row
google_str1 = "URL;https://www.google.de/search?q=testwort&num=100&hl=de&lr=&as_qdr=all&prmd=b& _
_
ei=05qkTISRCsrCswbF3MyaCA&start="
google_str2 = "&sa=N"
Cells.Select
Selection.ClearContents
For q = 100 To 1000 Step 100
googlestring = google_str1 & Str$(q)
With ActiveSheet.QueryTables.Add(Connection:= _
googlestring _
, Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
For Z = 1 To Sheets("Tabelle1").Cells(Cells.Rows.Count, 2).End(xlUp).Row
ZellInhalt = Cells(Z, 1)
If Mid(ZellInhalt, 1, 7) = "www.meineseite.de" Then
Tabende_Blatt2 = Tabende_Blatt2 + 1
Worksheets("Tabelle1").Range(Worksheets("Tabelle1").Cells(Z, 1), Worksheets("Tabelle1"). _
Cells(Z, 2)).Copy _
Worksheets("Tabelle2").Cells(Tabende_Blatt2, 1)
End If
Next Z
Next q
End Sub