"
HtmlDatei.writeline ""
HtmlDatei.writeline ""
HtmlDatei.writeline ""
HtmlDatei.close
'msgbox(fertig)
' hier könnte man den ie öffnen
wshshell.Run """" & HtmlDateiName & """"
' ********** logisches Ende
Sub CollectFiles(IFolder)
On Error Resume Next
For each IFile in IFolder.Files
ext = LCase(fso.GetExtensionName(IFile.Name))
If LCase(right(IFile.name, 3))= extension then
pfad = IFile.Path
Dateiname = IFile.Name
erstellZeilen pfad
End If
Next
For each Subfolder in IFolder.SubFolders
CollectFiles Subfolder
Next
On Error Goto 0
End sub
Sub erstellZeilen(pfad)
Set ODatei=fso.GetFile(pfad)
'Hole Dateihandle und erstelle ein Textstreamobjekt
Set Scriptdatei=ODatei.OpenAsTextStream(ForReading,TristateFalse)
i=10
z=0
Txt = ""
x="'"
fertig = false
While z < 10 'mehr als 10 Zeilen braucht man nicht auszuwerten
z = z + 1
x = ScriptDatei.ReadLine
if InStr(1,x,Chr(39))=1 then 'Zeile beginnt mit Hochkomma
x = Replace(x, chr(39), "", 1, 1)
Txt = Txt & " " & x
if ScriptDatei.AtEndOfStream = True then z = 99 end if
end if
wend
ScriptDatei.close
Txt = trim(cleanup(Txt))
writeZeile Left(pfad, InstrRev(pfad, "\")-1), dateiname, Txt
End sub
Sub writeZeile(tpfad, dateiname, Txt)
HtmlDatei.Writeline "
"
HtmlDatei.Writeline "
" & tpfad & "
"
Butt = ""
Butt = Replace(Butt, "\", "\\") 'Für den JS-Interpreter den Backslash maskieren
HtmlDatei.Writeline "
" & Butt & "
"
HtmlDatei.Writeline "
" & dateiname & "
"
HtmlDatei.Writeline "
" & Txt & "
"
HtmlDatei.Writeline "
"
End sub
function cleanup(text)
'das jeweilige zeichen sollte 3 mal gesucht werden, bevor es als überflüssig gilt
If instr(1,text,"*")>0 then 'suche nach "*"
'testcleanup = Replace(Text, "*", "", 1, 5)
'if not len(text)-len(testcleanup) > 1 then
text = Replace(Text, "*", "")
end if
If instr(1,text,"-")>0 then 'suche nach "-"
'testcleanup = Replace(Text,"-", "", 1, 5)
'if not len(text)-len(testcleanup) > 1 then
text = Replace(Text,"-", "")
end if
If instr(1,text,"=")>0 then 'suche nach "="
'testcleanup = Replace(Text, "=", "", 1, 5)
'if not len(text)-len(testcleanup) > 1 then
text = Replace(Text, "=", "")
end if
cleanup = text
end function