Hallo Wissende,
mit nachfolgendem Code kann ich problemlos „statische“ Internetseiten wie w-w-w auslesen und in eine Txt-Datei schreiben.
Bei „dynamischen“ Webseiten wie ein Chatfenster-Frame auf http://www.kilahu.de geht das prinzipiell auch, allerdings werden anschliessend permanent die angezeigten Beiträge der Chatteilnehmer gleich gelöscht, so dass ich quasi nur einmal auslesen kann.
Auch wenn ich vor Programmaufruf mit Firefox in einen Chatraum von Kilahu gehe, so wird dort dann auch nach Programmdurchlauf die Anzeige laufend gelöscht.
-
Wie kann ich das abstellen, daß immer das Chatfenster gelöscht wird?
-
Die beiden Do…Loop Schleifen führen zu Endlosschleifen, was kann man anstelle von readystate und busy noch abfragen?
-
Wie kann ich es erreichen dass jeder neue Beitrag im Chatfenster in die jeweils oberste freie Zelle von Spalte A in Excel geschrieben wird.
-
Excel Vba Lösungen wären mir am liebsten, aber wenn es nur mit VB geht, dann auch eine VB Löung, die ich per
Oeffne=Shell(Programmnae Frameadress Zeilenanzahl)
starten kann und die mir die Daten der letzten durch Zeilenanzahl gewählten Chatzeilen direkt nach Excel schreibt oder als Notbehelf in eine Txtdatei.
ps: die SessID in der Frameadresse muss durch die aktuelle SessID ersetzt werden, steht im Quelltext fast jedes Frames drinnen und beim IE auch in der Adresszeile.
Danke ^ Gruß
Reinhard
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub lesen()
Open "C:\www.txt" For Output As #1
Print #1, GetInnerX("http://www.wer-weiss-was.de/cgi-bin/forum/board.fpl?op=Anzeige&ThemenID=161", "HTML")
'Print #1, GetInnerX("http://insel.kilahu.de/servlet/kilahu?serv=core.chat&new=x&sess=vKD3kPXj1XLLY99f", "HTML")
'Print #1, GetInnerX("http://insel.kilahu.de/servlet/kilahu?serv=core.chat&new=x&sess=vKD3kPXj1XLLY99f", "Text")
Close 1
End Sub
Function GetInnerX(strURL As String, Optional strWhat As String = "HTML") As String
Dim objIE As Object, objDoc As Object
Dim strMldg As String
GetInnerX = ""
On Error GoTo ErrorHandler 'evtl. Fehler (auch serverseitig) abfangen
Set objIE = CreateObject("InternetExplorer.Application")
'Set objIE = GetObject("", "InternetExplorer.Application")
objIE.Visible = True
'objIE.Visible = False
objIE.Navigate strURL
Sleep 2000
'Do While objIE.Busy
'Loop
Set objDoc = objIE.Document
Sleep 2000
'Do While objDoc.readyState "complete"
'Loop
Select Case UCase(strWhat)
Case "HTML"
GetInnerX = objDoc.Body.InnerHTML
Case Else
GetInnerX = objDoc.Body.InnerText
End Select
objIE.Quit
Exit Function
ErrorHandler:
If Err.Number 0 Then
strMldg = "Fehler 0x" & Hex(Str(Err.Number)) & " wurde ausgelöst von " \_
& Err.Source & Chr(10) & Err.Description
MsgBox strMldg, vbCritical, "Fehler beim Zugriff auf WWW via InternetExplorer", Err.HelpFile, Err.HelpContext
Err.Clear
End If
End Function
Gruß
Reinhad