AW: Webseiten-Abfrage
23.03.2010 12:02:05
Luschi
Hallo Tobias,
da das Ansprechen der Tabellen auf dieser I-Net-Seite nicht dem Standaed entspricht, habe ich _
es so gelöst:
Sub WebseiteAusfuellen()
Dim appIE As Object
Dim strDatum As String, meinDatum As Date
Dim varTable, varTables
Dim rg As Range, _
s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, _
i1 As Integer, i2 As Integer, _
myArr() As String
meinDatum = DateSerial(2010, 3, 1) 'hier Dein Datum
strDatum = Format(meinDatum, "dd\/mm\/yyyy")
Set appIE = CreateObject("InternetExplorer.application")
appIE.Navigate "http://www.polpx.pl/main.php?lang=en&okres=dzien&show=38&index=242&s_data=24% _
2F02%2F2010"
While Not appIE.ReadyState = 4 'Warte auf Webseite
DoEvents
Wend
appIE.Document.All.s_data.Value = strDatum
appIE.Document.Forms(0).submit
appIE.Visible = True
'warten auf Aktualisierung
While Not appIE.busy
DoEvents
Wend
'Da die obere schleife nicht immer korrekt funktioniert
MsgBox "Jetzt gehts weiter..."
Set varTables = appIE.Document.All.tags("TABLE")
For Each varTable In varTables
If varTable.innerText Like "*" & strDatum & "*" Then
s1 = varTable.innerText
s2 = "Hour Fixing I (Opening price) Fixing II Avg. weighted price Volume"
s3 = "Block contracts"
i1 = InStr(1, s1, s2, vbTextCompare)
s4 = Mid(s1, i1 + Len(s2) + 3)
i2 = InStr(1, s4, s3, vbTextCompare)
s5 = Trim(Left(s4, i2 - 8))
s5 = Replace(s5, " " & vbCrLf, " ", 1, -1, vbTextCompare)
myArr = Split(s5, " ", -1, vbTextCompare)
Set rg = ActiveSheet.Range("B1")
rg.Offset(0, -1).Value = meinDatum
rg.Value = "Avg. weighted price"
For i1 = 3 To UBound(myArr()) Step 5
Set rg = rg.Offset(1, 0)
rg.Value = myArr(i1)
Next i1
Exit For
End If
Next varTable
Set varTable = Nothing
Set varTables = Nothing
Set rg = Nothing
Set appIE = Nothing
End Sub
Gruß von Luschi
aus klein-Paris