bei folgendem Marko versuche ich den Inhalt einer Seite auszulesen. Ich bekomme aber komischerweise nur einige Zeilen und nicht den gesamten Text? Weiß jemand schlauen Rat?
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Sub X()
Dim t As Single
t = Timer
Sleep 1500
Debug.Print Timer - t
End Sub
Sub LoadEspaceNet()
Dim Description(1, 5000, 1)
Dim Browser As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Set Browser = New SHDocVw.InternetExplorer
Browser.Visible = True
Application.StatusBar = ".... opening page"
'Espacenet Homepage
Browser.navigate "http://worldwide.espacenet.com/?locale=de_EP" ' navigate to page
'On Error Resume Next
Do While Browser.Busy
DoEvents
Loop
NumberDoc = 1
Set HTMLDoc = Browser.Document ' load the DOM object
Do While Browser.Busy
DoEvents
Loop
Dim Elem As Variant
MsgBox "Load Document!"
With HTMLDoc
currentdoc = "EP2840773A2"
.getElementById("cqlEditBox").Value = currentdoc
.getElementById("submit").Click
Do While Browser.Busy
DoEvents
Loop
Call X
Do While Browser.Busy
DoEvents
Loop
MsgBox "Loading Document ... "
.getElementById("Publicationid1").Click
End With
Do While Browser.Busy
DoEvents
Loop
'Description Upload
Do While Browser.Busy
DoEvents
Loop
Call X
For Each Coll In HTMLDoc.getElementsByTagName("a")
jx = jx + 1
If InStr(Coll.innerText, "Beschreibung") > 0 Then Coll.Target = "_self": Coll.Click: Exit For
': If jx = 64 Then Coll.Click: Exit For
Next
Do While Browser.Busy
DoEvents
Loop
MsgBox "Loading Description/Translation"
With HTMLDoc.getElementById("translatethislink")
.Target = "_self"
.Click
End With
Call X
Do While Browser.Busy
DoEvents
Loop
For Each ad In HTMLDoc.getElementsByTagName("a")
If InStr(ad.innerText, "Deutsch") > 0 Then ad.Target = "_self": kj = True: ad.Click: Exit For
If InStr(ad.innerText, "Englisch") > 0 Then ad.Target = "_self": kj = True: ad.Click: Exit For
Next
MsgBox "Document "
jxcounter = 0
innerdescription = ""
innerdescription = HTMLDoc.getElementById("text").innerText
Selection.WholeStory
Selection.Delete
Selection.TypeText innerdescription
End Sub
|