Dynamischen Hyperlink im Web aufrufen
03.01.2004 19:09:56
Heidi
habe lange selbst geknobelt, komme aber nicht mehr weiter.
Zum Hintergrund:
Ich surfe per VBA-Schleife verschiedene Webseiten an und kopiere Teile des Html-Quellcodes raus, um mit dessen Inhalt Auswertungen in Excel zu machen. Das funktioniert auch soweit alles, bei allen anderen Gesellschaften - außer bei ESSO.
Bei allen anderen Gesellschaften (Aral, V-Markt, Shell, Total und BP) sind die Links der Benzinpreisseiten statisch, bei ESSO sind sie dynamisch.
Hier ein Beispiellink:
http://www.esso.de/auftanken/tankstelle_gesucht_gefunden/tankstellen_finder/search.html?type=ort&query=kempten
Das ist der statische Link für die Esso-Preisseite in Kempten, bei jedem Aufrufen des "Ort"-Links (hier Kempten) wird jedesmal eine andere dynamische URL-Adresse vergeben. (welche ich aber immer gern 'direkt' ansurfen würde)
Nun zu meiner Frage:
Gibt es eine Möglichkeit, diesen (dynamischen) Link direkt anzusurfen per VBA? (um dann Quelltext rauszukopieren usw...), und wenn ja wie?
Ich habe schon Herbers FAQ's "extern" durchforstet, habe aber nichts gefunden, was mir weiterhilft.
Danke schon mal fürs durchlesen,
Mfg Heidi
Hier ist der Quelltext zum ansurfen statischer URL's:
Option Explicit
Sub Aufruf()
'Deklarationen
Dim i As Byte
Dim webadresse As String
Dim blattname As String
Dim lkwdk As String
'Aufruf ARAL
For i = 1 To 15
webadresse = Workbooks("Basis.xls").Sheets("Stammdaten").Cells(3 + i, 53) 'Position, wo die Webadresse steht
If Workbooks("Basis.xls").Sheets("Stammdaten").Cells(3 + i, 53) = "" Then
GoTo weiteraral 'Sprungmarke, falls in einer Zelle keine Webadresse steht
Else
'Blattname ist zugleich der Name des Tabellenblattes
blattname = Workbooks("Basis.xls").Sheets("Stammdaten").Cells(3 + i, 2)
lkwdk = Workbooks("Basis.xls").Sheets("Stammdaten").Cells(3 + i, 54) 'LKW DK ja oder nein
Call URL_Load_aral(webadresse, blattname, lkwdk)
End If
weiteraral:
Next i
End Sub
'Prozedur zum Aufrufen der jeweiligen Webseite und rausfiltern bestimmter Teile des Quelltextes
Sub URL_Load_aral(ByVal sURL As String, ByVal blattname As String, ByVal lkwdk As String)
Dim appIE As Object, lfCount As Integer, txtSearch As Long
Dim sTxt As String, txtLine As String, txtbool As Boolean
Dim vk1 As Byte, vk2 As Byte, vk3 As Byte, vknk As Byte
Dim dk1 As Byte, dk2 As Byte, dknk As Byte
Dim x As Byte, anzahl As Byte
Dim datum As Date
Dim uhrzeit As Date
Set appIE = CreateObject("InternetExplorer.Application")
appIE.navigate sURL
Do: Loop Until appIE.Busy = False
Do: Loop Until appIE.Busy = False
sTxt = appIE.document.documentElement.outerhtml
Set appIE = Nothing
Close
Open ThisWorkbook.Path & "\test.txt" For Output As #1
lfCount = 1
For txtSearch = 1 To Len(sTxt)
If txtbool Then
If Mid(sTxt, txtSearch, 1) = vbCr Then
Print #1, txtLine
txtLine = ""
txtbool = False
Else
txtLine = txtLine & Mid(sTxt, txtSearch, 1)
End If
Else
If Mid(sTxt, txtSearch, 1) = vbLf Then lfCount = lfCount + 1
If lkwdk = "ja" Then
Select Case lfCount
Case 42 To 45: txtbool = True 'Zeile 42 bis 45 Benzin
Case 118 To 120: txtbool = True 'Zeile 118 bis 120 Diesel
Case 157: txtbool = True 'Uhrzeit und Datum mit LKW-DK
End Select
Else
Select Case lfCount
Case 42 To 45: txtbool = True 'Zeile 42 bis 45 Benzin
Case 118 To 120: txtbool = True 'Zeile 118 bis 120 Diesel
Case 132: txtbool = True 'Uhrzeit und Datum ohne LKW-DK
End Select
End If
End If
Next
Close
MsgBox "Der Text wurde gespeichert unter:" & vbLf & ThisWorkbook.Path & "\test.txt"
'Textdatei in Excel öffnen
Workbooks.OpenText Filename:= _
"C:\Dokumente und Einstellungen\heidi\Desktop\test.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 9), Array(72, 4), Array(82, 9), Array(83, 1), Array(88, 9), Array(91, 1), _
Array(92, 9), Array(93, 1), Array(94, 9))
'benötigten Zellinhalten aus importierter txt-Datei Variablen zuweisen
vk1 = Workbooks("test.txt").Sheets(1).Cells(1, 4)
vk2 = Workbooks("test.txt").Sheets(1).Cells(2, 4)
vk3 = Workbooks("test.txt").Sheets(1).Cells(3, 4)
vknk = Workbooks("test.txt").Sheets(1).Cells(4, 3)
dk1 = Workbooks("test.txt").Sheets(1).Cells(5, 4)
dk2 = Workbooks("test.txt").Sheets(1).Cells(6, 4)
dknk = Workbooks("test.txt").Sheets(1).Cells(7, 3)
datum = Workbooks("test.txt").Sheets(1).Cells(8, 1)
uhrzeit = Workbooks("test.txt").Sheets(1).Cells(8, 2)
Workbooks("test.txt").Close
'Das richtige Tabellenblatt ermitteln und Variablenwerte einfügen
Workbooks("Basis.xls").Sheets(blattname).Cells(7, 2) = vk1 & vk2 & vk3 & "," & vknk
Workbooks("Basis.xls").Sheets(blattname).Cells(6, 2) = dk1 & dk2 & "," & dknk
Workbooks("Basis.xls").Sheets(blattname).Cells(8, 2) = datum & " " & uhrzeit
End Sub