Titel aus HTML-Datei auslesen

CreateObject("Scripting.FilesystemObject"), OpenTextFile, ReadLine, InStr
Const FOR_READING = 1
Function Titel_aus_HTML_lesen(PfadNam As String, PageTitle As String)
Dim FileObject As Object, FileNam As Object, Line$, x%, y%
 Set FileObject = CreateObject("Scripting.FilesystemObject")
 Set FileNam = FileObject.OpenTextFile(PfadNam, FOR_READING, True)
 Do While Not FileNam.AtEndOfStream
  'Einlesen der Zeilen (Line = Zeileninhalt als String)
  Line = FileNam.ReadLine()
  x = VBA.InStr(Line, "<title>")
  y = VBA.InStr(Line, "</title>")
  'Wenn Zeile gefunden, die Strings "<title>" und "</title>" enthalten
  If x <> 0 And y <> 0 Then
   'Titel ausschneiden
   PageTitle = VBA.Mid(Line, x + 7, y - x - 7)
  
   FileNam.Close
   Set FileNam = Nothing
   Set FileObject = Nothing
   Exit Function
  End If
 Loop
 'wenn kein Titel gefunden
 PageTitle = "nix gefunden"
 FileNam.Close
 Set FileNam = Nothing
 Set FileObject = Nothing
End Function
An Function wird übergeben: Pfad/Dateiname
Function gibt zurück: Titel der HTML-Seite
Obige Function wird verwendet um z.B. ein Excel-Inhaltsverzeichnis für die eigene Homepage zu erstellen:
Sub HTML_Files_lesen()
Dim SheetNam$, Datei$, HtmlVerz$, Titel$
 HtmlVerz = "D:\MyWebroot\"
 Datei = VBA.Dir(HtmlVerz & "*.htm*")
 While Datei <> ""
   'Titel der HTML-Datei auslesen
   Call Titel_aus_HTML_lesen(HtmlVerz & Datei, Titel)
   
   '1. Spalte enthält Pfad und Dateiname
   SheetNam = HtmlVerz & Datei
   ActiveCell.Value = SheetNam
   'Hyperlink einfügen
   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=SheetNam
   '2. Spalte enthält Titel der HTML-Datei
   ActiveCell.Offset(0, 1).Select
   ActiveCell.Value = Titel
   ActiveCell.Offset(1, -1).Select
   'nächste HTML-Datei
   Datei = VBA.Dir()
 Wend
End Sub

 Ranking-Hits zurück Sitemap
Designed by www.wbrnet.info