Makro funktioniert im Debug modus aber nicht real
10.09.2007 15:55:32
Pascal
Tja, da weiß ich nicht weiter. ich möchte eine google-Abfrage per Makro durchführen, um sie hinterher auszuwerten. Aber das Makro funktioniert nur im Debug Modus via Einzelschritt sonst leider nicht.
Aus Tabelle Eingabeseite wird die Abfrage gelesen. In Tabelle Einfügeseite wird die Google Abfrage einfache hineinkopiert. In Tabelle Datenbank sollen die Ergebnisstrings eingefügt werden.
Die Tabelle Ergebnisstring wird nicht wie erwartet mit den Domains und einer Nummer gefüllt, sondern nur mit einem leeren Feld und einer 0. (Wie gesagt, wenn ich auf Einzelschritt gehe, erscheint alles wie gewünscht)
Hat jemand eine Idee? Besten Dank!
Pascal
Hier das Makro.
Sub Seitenanalyse_starten()
On Error Resume Next
Dim strURL(20) As String
Dim strPruef As String
Dim strAusgabe As String
Dim strWertZeile(1000) As String
Dim numWertZeile(1000) As Integer
Dim a, i As Integer
Sheets("Eingabeseite").Select
' * Festlegen der einzelnen URL für die Abfrage
strURL(1) = "URL;"
strURL(2) = Cells(12, 3)
strURL(3) = Cells(12, 4)
strURL(4) = Cells(12, 5)
strURL(5) = Cells(12, 6)
strURL(6) = Cells(12, 7)
strURL(7) = Cells(12, 8)
strURL(8) = Cells(12, 9)
strURL(9) = Cells(12, 10)
strURL(10) = Cells(12, 11)
strURL(11) = Cells(12, 12)
strURL(12) = Cells(12, 13)
strURL(13) = Cells(12, 14)
strURL(14) = Cells(12, 15)
strURL(15) = Cells(12, 16)
strURL(16) = Cells(12, 17)
strURL(17) = Cells(12, 18)
strURL(18) = Cells(12, 19)
Sheets("Einfügeseite").Select
With ActiveSheet.QueryTables.Add(Connection:= _
strURL(1) + strURL(2) + strURL(3) + strURL(4) + strURL(5) + strURL(6) + strURL(7) + _
strURL(8) + strURL(9) + strURL(10) + strURL(11) + strURL(12) + strURL(13) + strURL(14) + strURL( _
15) + strURL(16) + strURL(17) + strURL(18), _
Destination:=Range("A1"))
.Name = "test"
.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:=True
End With
' Application.ScreenUpdating = True
' * Seitenanalyse
' * Version 1.0 -
' * Montag 10.09.2007
' * Modul Google mit eingeloggtem Zustand
i = 1
For a = 1 To 100
strPruef = Cells(a, 1)
If InStr(1, strPruef, "Notieren") 0 Then
pos = InStr(1, strPruef, "/")
strAusgabe = Mid(strPruef, 1, pos - 1)
strWertZeile(i) = strAusgabe
numWertZeile(i) = i
i = i + 1
End If
Next a
' * Schreiben der Datensätze
' * Version 1.0 -
' * Montag 10.09.2007
Sheets("Datenbank").Select
For a = 1 To 100
Cells(a, 10) = strWertZeile(a)
Cells(a, 11) = numWertZeile(a)
Next a
End Sub