| 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 |
|