so gehts bei mir...
23.03.2010 15:56:45
Tino
Hallo,
teste mal
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ZahlenFinden(strString As String)
Dim Regex As Object, objMatch As Object, objMatchZahl As Object
Dim strText$, nCount As Integer, nSpalte As Integer
Dim LRow As Long
Dim KommaOrPkt As String
KommaOrPkt = IIf("0.5" * 2 = 1, ".", ",")
LRow = 2 'beginne in Zeile 2
Set Regex = CreateObject("Vbscript.Regexp")
'Debug.Print strString
With Regex
.IgnoreCase = True
.MultiLine = True
.Pattern = ">\d+.\d+\D+</TD>|>\d+\D+</TD>"
.Global = True
Set objMatch = .Execute(strString)
If Not objMatch Is Nothing Then
.Pattern = "\d+.\d+|\d+"
nSpalte = 4
For Each objMatch In objMatch
nCount = nCount + 1
If nCount = nSpalte Then
Set objMatchZahl = .Execute(objMatch)
If Not objMatchZahl Is Nothing Then
Cells(LRow, 1) = Replace(objMatchZahl(0), ".", KommaOrPkt) * 1
LRow = LRow + 1
End If
nSpalte = nSpalte + 5
End If
Next objMatch
End If
End With
End Sub
Sub WebseiteAusfüllen()
Dim appIE As Object
Dim strDatum As String, MeinDatum As Date
Dim strBody$
Dim i As Integer
MeinDatum = DateSerial(2010, 3, 1) 'hier Dein Datum
strDatum = Format(MeinDatum, "dd\/mm\/yyyy")
Range("A2").Resize(Rows.Count - 1).Clear
Set appIE = CreateObject("InternetExplorer.application")
appIE.Visible = False 'kann auf False gesetzt werden
appIE.Navigate "http://www.polpx.pl/main.php?lang=en&okres=dzien&show=38&index=242&s_data=24%2F02%2F2010"
'Warte auf Webseite, maximal 10 Sekunden
While (Not appIE.ReadyState = 4) And i < 100
DoEvents
Sleep 100
i = i + 1
Wend
If i >= 100 Then
MsgBox "Webseite konnte nicht aufgebaut werden", vbCritical
GoTo ErrorH:
End If
appIE.Document.all.s_data.Value = strDatum
appIE.Document.Forms(0).submit
For i = 1 To 50 'fünf Sekunden warten, eventuell höher einstellen
DoEvents
Sleep 100
Next i
strBody$ = appIE.Document.Body.InnerHtml
appIE.Quit
ZahlenFinden strBody$
Range("A2").EntireColumn.AutoFit
ErrorH:
appIE.Quit
Set appIE = Nothing
End Sub
Gruß Tino