22.08.2013

3748

Dateien eines Ordners auslesen und in eine HTML-Datei schreiben

Hallo Freunde,
wieder einmal stehe ich mit meinen Nano-Programmierkenntnissen auf dem Schlauch und würde mich über Hilfe sehr freuen.
Und zwar möchte ich mit einem Script aus allen db-Dateien (Extension .db) eines Ordners Strings extrahieren, die immer an der gleichen Position (Dateianfang) der Binärdateien positioniert sind. Diese Strings sollen dann zeilenweise in eine Galeriedatei für jeden Ordner geschrieben werden (HTML-Format).
Der zeilenweise Satzaufbau innerhalb dieser HTML-Datei sollte recht einfach sein: Thumbnail mit Link zur Originalbilddatei | Name der Trägerdatei mit Link zur Originalbilddatei. Die Trägerdatei ist die oben erwähnte Binärdatei mit Angabe des Thumbnail-Links, der Link des Originalbildes wird aus dem Thumbnail-Link gebildet.

Ich habe zwei Scripte zusammengebastelt, aber die sind in Visual Basic. Ich besitze kein Visual Basic, muß das Script also aus dem Microsoft Office (2003) als VBA-Anwendung starten. Den Pfad der Trägerdatei gebe ich über eine Inputbox ein und erhalte auch das gewünschte Ergebnis, aber für fast 100 Dateien pro Ordner ist das doch sehr mühselig und ich suche nach einer Automatisation.

Hier nun der Code:

Sub Extraktor()
Dateiname = InputBox("Geben Sie den Dateinamen - mit Pfad - an")  
sBuffer = FileRead(Dateiname)
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objFile = objFSO.CreateTextFile(Dateiname & ".html")  
sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild  
lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild  
objFile.Write "<html>" & vbCrLf & "<a href=" & lBuffer & ">" & "<img src=" & sBuffer & "><br>" & Dateiname & "<br></img></a><br>" & vbCrLf  
' Erstellt folgende HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br>  
objFile.Write "</html>"  
MsgBox sBuffer
objFile.Close
End Sub

Function FileRead(ByVal sFile As String, _
  Optional ByVal nStartPos As Long = 1, _
  Optional ByVal nBytesToRead As Long = 0) As String
' (C) Dietmar Otter | vbarchiv.net  
  Dim F As Integer
  Dim nFileLen As Long
  Dim sBuffer As String
 
  ' Datei im Binary-Mode öffnen  
  F = FreeFile
  Open sFile For Binary As #F
 
  ' Dateigröße in Bytes  
  nFileLen = LOF(F)
 
  ' Falls "BytesToRead" nicht angegeben oder 0,  
  ' gesamten Inhalt ab "StartPos" auslesen  
  If nBytesToRead = 0 Then nBytesToRead = nFileLen
 
  ' Falls StartPos < 1, Bytes rückwärts vom  
  ' Dateiende auslesen  
  If nStartPos < 1 Then
    nStartPos = nFileLen
    nBytesToRead = -Abs(nBytesToRead)
  End If
 
  ' Falls "StartPos" > Dateigröße und  
  ' "BytesToRead" < 0, Funktion beenden  
  If nStartPos > nFileLen And nBytesToRead < 0 Then
    Close #F
    Exit Function
  End If
 
  ' Leseposition ermitteln  
  If nBytesToRead < 1 Then
    nBytesToRead = Abs(nBytesToRead)
    nStartPos = nStartPos - nBytesToRead + 1
    If nStartPos < 1 Then
      nBytesToRead = nBytesToRead - Abs(nStartPos) - 1
      nStartPos = 1
    End If
  End If
 
  If nStartPos + nBytesToRead - 1 > nFileLen Then
    nBytesToRead = nFileLen - nStartPos + 1
  End If
 
  ' Inhalt auslesen  
  sBuffer = Space$(nBytesToRead)
  Seek #F, nStartPos
  Get #F, , sBuffer
 
  ' Datei schließen  
  Close #F
 
  FileRead = sBuffer
End Function

Mein Anliegen wäre also:

Durchlaufen der Extraktor-Schleife für alle *.db-Trägerdateien (Endung db) im jeweiligen Ordner.
Portierung des Codes zu Visual Basic Script (VBS), um nicht immer über das MS Office starten zu müssen.

Ich danke ersteinmal für die Mühe und bin gespannt auf Eure Antworten

Mike

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 214981

Url: https://administrator.de/forum/dateien-eines-ordners-auslesen-und-in-eine-html-datei-schreiben-214981.html

Ausgedruckt am: 06.01.2025 um 23:01 Uhr

14 Kommentare

Neuester Kommentar

Hallo Gurkenhobel!

Ich besitze kein Visual Basic

Das besitzt Microsoft

- eine Lizenz könntest Du aber bekommen: http://www.microsoft.com/visualstudio/eng/downloads#d-2012-express

Die Schleife sollte keine große Sache sein - ungetestet etwa so:

Sub Extraktor()
Pfad = "D:\Dein Pfad"  
Set objFSO = CreateObject("Scripting.FileSystemObject")  
For Each Dateiname In objFSO.GetFolder(Pfad).Files
    sBuffer = FileRead(Dateiname)
    Set objFile = objFSO.CreateTextFile(Dateiname & ".html")  
    sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild  
    lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild  
    objFile.Write "<html>" & vbCrLf & "<a href=" & lBuffer & ">" & "<img src=" & sBuffer & "><br>" & Dateiname & "<br></img></a><br>" & vbCrLf  
    ' Erstellt folgende HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br>  
    objFile.Write "</html>"  
    MsgBox sBuffer
    objFile.Close
Next
End Sub

Hinsichtlich der Portierung: VBS unterstützt nativ keine Binär-Dateien - Workarounds gibt es aber (zB von hier) gezeigt ...

Grüße
bastla

Hallo bastla,
danke für die schnelle Antwort. Ja das Schreiben der HTML-Dateien klappt ganz gut. Aber eigentlich wollte ich ja eine "Galeriedatei" haben, in der die einzelnen Links der Thumbnails und Originalbilder gespeichert sind, zeilenweise etwa so:

'  HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br>   

Ich hatte da eher an so etas gedacht

Sub Versuch()
Pfad = "I:\MeinPfad"  
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objAusgabe = objFSO.CreateTextFile("Galerie.html") ' die soll erstellt werden ...  
For Each Dateiname In objFSO.GetFolder(Pfad).Files
    sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild  
    lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild  
    objAusgabe.Write sBuffer & vbTab & lBuffer & vbTab & Dateiname & vbCrLf ' vereinfachte Ausgabe als Text  
      Next
    objAusgabe.Close
End Sub

Was aber nicht funktioniert...

Schade, daß man nicht portieren kann, VB werde ich mir wohl nicht zulegen. Ich muss eh nur Textmanipulationen und Dateioperationen ausführen, da genügt VBS.

Hallo Gurkenhobel!

Schade, daß man nicht portieren kann

Hast Du Dir denn den oben verlinkten Beitrag angesehen?

Grüße
bastla

Hallo bastla,

Hast Du Dir denn den oben verlinkten

Beitrag angesehen?

angeschaut schon, aber net so richtig begriffen...
Grüße
Mike

Hallo Gurkenhobel!

Alternative: Read and write binary file in VBscript

Grüße
bastla

Hallo bastla,

das sieht schon begreiflicher aus. Werde es ab Morgen mal versuchen...
Das Makro Versuch von 17:38 läuft aber immer noch nicht so wie gewollt..

Edit: 25.08.2013 - Aus dem MS Office heraus habe ich das Makro Versuch zum Laufen gebracht...

Grüße
Mike

Hallo,

Ich habe mich nun doch für die Lösung von @76109 entscheiden.
Allerdings vorerst nur zur Probe, denn ich muss jede Datei einzeln eingeben, aus der dann die Bytes 12 bis 99 ausgelesen und in eine Datei mit gleichem Präfix (Name vor dem Punkt) geschrieben werden. Leider läßt sich beim Binären Lesen und Schreiben kein zusätzlicher Text unterbringen. So daß man wohl die Datei erst schließen muss und erst dann weiter bearbeiten kann.

Außerdem suche ich nach einer Lösung, wie man das Ganze automatisiert für jeden Ordner erledigen kann. Es soll jede Datei mit der Endung ".D" in einer Galerie- oder Indexdatei eingetragen werden.

Mein Script nach Windows-Scriptsprache mit Binärdatei-Funktionalität ?:

TestFile=Inputbox("Bitte geben Sie die Trägerdatei an","Trägerdatei mit Link auslesen")  

BinFile = Left(TestFile, Len(TestFile)-2) & ".html"  

Const Anfang = 12
Const Ende = 99

Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2

Dim Fso, File, BinStream, TextStream, BinArray, i
    
Set Fso = CreateObject("Scripting.FileSystemObject")  
Set File = Fso.OPenTextFile(TestFile)
Set BinStream = CreateObject("ADODB.Stream")  
    
With BinStream
'Schritt 5 (Trägerdatei einlesen)  
'TestFile ab Position SkipKopf bis SkipFuss in Byte-Array einlesen  
.Type = adTypeBinary
 .Open
 .LoadFromFile TestFile
 .Position = Anfang 
  BinArray = .Read(Anfang + Ende)
 .Close
 
'Schritt 7 (BinFile schreiben)  
 .Open
 .write BinArray
 .SaveToFile BinFile, adSaveCreateOverWrite
 .Close
End With

Grüße
Mike

Hallo Gurkenhobel!

wie man das Ganze automatisiert für jeden Ordner erledigen kann

... ist im Prinzip oben schon gezeigt - wenn Du nicht das jeweilige Datei-Objekt, sondern dessen Pfad benötigst, kannst Du ja

For Each Datei In objFSO.GetFolder(Pfad).Files
    TestFile = Datei.Path

verwenden ...

Dateiname (ohne Extension) und Extension bekommst Du übrigens so:

TestFileName = objFSO.GetBaseName(Datei.Path)
TestFileExt = objFSO.GetExtensionName(Datei.Path)

Grüße
bastla

Hallo Bastla,
mit dem Code

Set objFso = CreateObject("Scripting.FileSystemObject")  
Pfad="c:\Users\Michael\Documents\Webshots\.cachedir\data7\f"  
Const Anfang = 12
Const Ende = 99
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2

For Each Datei In objFSO.GetFolder(Pfad).Files 
TestFile = Datei.Path

Dim Fso, File, BinStream, TextStream, BinArray, i
    
' Set File = Fso.OpenTextFile(Datei)  
BinFile = Left(TestFile, Len(TestFile)-2) & ".html"  

Set BinStream = CreateObject("ADODB.Stream")  
With Bitstream...

wird nun für jede .D-Datei ein .HTML-Pendant geschrieben. Wie kommen nun alle Dateinamen in eine Liste (Indexdatei) und wie kann man dort noch zusätzlichen Text (z.B. HTML-Tags) unterbringen ??

Danke ersteinmal
Mike

Hallo Gurkenhobel!

Wie kommen nun alle Dateinamen in eine Liste (Indexdatei)

Indem Du sie hineinschreiben lässt? Wenn Du die Indexdatei vor der Schleife als Objekt erstellst (wie das syntaktisch geht, findest Du ja schon ganz oben in Zeile 5 Deines eigenen Entwurfs), kannst Du sie innerhalb der Schleife mit den entsprechenden Zeilen befüllen (analog zur Zeile 8) ...

Grüße
bastla

Hallo Bastla,
der erste Test mißlang: Fehler in Zeile 31

...
Set objAusgabe = objFSO.CreateTextFile("index.html") ' die soll erstellt werden   

For Each Datei In objFSO.GetFolder(Pfad).Files 
TestFile = Datei.Path

Dim Fso, File, BinStream, TextStream, BinArray, i
    
' Set File = Fso.OpenTextFile(Datei)  
BinFile = Left(TestFile, Len(TestFile)-2) & ".html"  

Set BinStream = CreateObject("ADODB.Stream")  
    
With BinStream
'Schritt 5 (Trägerdatei einlesen)  
'TestFile ab Position SkipKopf bis SkipFuss in Byte-Array einlesen  
.Type = adTypeBinary
 .Open
 .LoadFromFile TestFile
 .Position = SkipKopf 
  BinArray = .Read(SkipKopf + SkipFuss)
 .Close
 
'Schritt 7 (BinFile schreiben)  
 .Open
 .write BinArray
 .SaveToFile BinFile, adSaveCreateOverWrite
 .Close
End With

objAusgabe.Write BinStream.BinArray '<-Fehler Argumente vom falschen Typ|außerhalb des Gültigkeitsbereichs|miteinander unvereinbar  

Next

objAusgabe.close

Ich mach jetzt ersteinmal Schluß - Buliseiruf geht gleich los. Schön' Aband und Grüße
Mike

Hallo Gurkenhobel!

Das Schreiben mittels "FileSystemObject" ist für reine Textdateien gedacht - so hätte ich auch Deine Absicht

Diese Strings sollen dann zeilenweise in eine Galeriedatei für jeden Ordner geschrieben werden (HTML-Format).

(als zusätzliche Dateiliste) interpretiert; ansonsten musst Du natürlich bei der Binärdatei-Variante bleiben und versuchen, Deine Textbestandteile vor dem Schreiben passend in die Variable "BinArray" einzubauen ...

Grüße
bastla

Hallo bastla,

Leider komme über einen Typenkonflikt nicht hinaus....
Schade, daß ich mir als Bloody Beginner in VBS die Scriptteile mühselig zusammen"bastla"n muss.
Wie kann ich denn nun die Textbestandteile in das "BinArray" einbinden ?

Geht es damit ?

Function SaveBinaryDataTextStream(FileName, ByteArray)
  'Create FileSystemObject object  
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")  
  
  'Create text stream object  
  Dim TextStream
  Set TextStream = FS.CreateTextFile(FileName)
  
  'Convert binary data To text And write them To the file  
  TextStream.Write Stream_BinaryToString(ByteArray)
End Function

'BinaryToString Function  
'2003 Antonin Foller, http://www.motobit.com  
'Binary - VT_UI1 | VT_ARRAY data To convert To a string   
'CharSet - charset of the source binary data - default is "us-ascii"  
Function Stream_BinaryToString(Binary, CharSet)
  Const adTypeText = 2
  Const adTypeBinary = 1
  
  'Create Stream object  
  Dim BinaryStream 'As New Stream  
  Set BinaryStream = CreateObject("ADODB.Stream")  
  
  'Specify stream type - we want To save text/string data.  
  BinaryStream.Type = adTypeBinary
  
  'Open the stream And write text/string data To the object  
  BinaryStream.Open
  BinaryStream.Write Binary
    
  'Change stream type To binary  
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeText
  
  'Specify charset For the source text (unicode) data.  
  If Len(CharSet) > 0 Then
    BinaryStream.CharSet = CharSet
  Else
    BinaryStream.CharSet = "us-ascii"  
  End If
  
  'Open the stream And get binary data from the object  
  Stream_BinaryToString = BinaryStream.ReadText
End Function