Webabfrage
Mathias
ich möchte über ein Bild (ist in meinem Tabellblatt eingefügt), welches gleichzeitig einen Hyperlink zu einer Internetseite beinhaltet, eine Webabfrage starten.
Hier möchte ich immer den Inhalt einer bestimmten Zeile der Webseite abfragen und in eine Zelle (kann beliebig sein) eintragen.
Hier ist mein Beispiel, dass ich teilweise selbst geschrieben und teilweise mit dem Makrorekosder aufgezeichnet habe.
Option Explicit
Private Sub Abfrage()
Dim objShapes As Shape
Dim i As Integer
Dim sAdresse As String
On Error Resume Next
For i = 1 To 500
Set objShapes = ActiveSheet.Shapes("Picture " & i)
If Err.Number = "-2147024809" Then GoTo Fehler
sAdresse = objShapes.Hyperlink.Address
With ActiveSheet.QueryTables.Add(Connection:="URL;" & sAdresse, Destination:=Sheets("Tabelle3" _
_
).Range("A1"))
.Name = Mid(sAdresse, 43)
' .Name = "tmtrack.dll?StdPage&Template=changedetails&RecordId=215&TableId=1071& _
chgactionid=1747224"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """CFOTitle"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
i = i + 8
Next
Fehler:
Err.Clear
Exit Sub
End Sub
Leider funzt es nicht wie besagt. Ich bekomme keinen Eintrag in die hier beschriebene Zelle A1 des Tabellenblattes 3.
Kann mir jemand helfen?
Gruß
Mathias