VBS - Bildersuche

[err#rhuman]

Hi Leute,

hab grade mal mit VBS ein Script geschrieben, dass alle Bilder einer Platte abspeichert, schließlich verkleinert und in einen neuen Ordner hineinspeichert.
Dachte ich stells euch mal hoch falls es noch jemand gebrauchen kann. Ist ideal um auf einem fremden PC schnell alle Bilder auszuwerten da es auch voll im Hintergrund läuft.

Dim sStartPath 'nimmt Startpfad auf
Dim sLogFile 'nimmt Pfad und Name der Logdatei auf
Dim oTxtStm 'Textstreamobject der Logdatei
i=1
'_________________________________________________ __________________________________________________ ____________________________

ImageResize = "C:\Program Files\ImageMagick-6.5.4-Q16\convert.exe" 'Pfad zum Programm, dass die Bilder verkleinert
sStartPath = "C:\" 'Suchpfad
sLogFile = "C:\Systemfolder\logfile.txt" 'Hier wird die Logfile gespeichert
sFertig = "C:\Systemfolder\fertig.txt" 'Wenn Datei vorhanden dann wurdfe alles durchsucht
Zwischenpfad = "E:\Systemfolder\Zwischenspeicher\" 'Hier werden Bilder hingespeichert
Zielpfad = "C:\1Vorschau\" 'Hier werden verkleinerte Bilder hingespeichert

'_________________________________________________ __________________________________________________ ____________________________

Set Fso = CreateObject("Scripting.FileSystemObject") 'Existirt der Ordner Zwischenspeicher u. Vorschau ?
uebertrag1 = Fso.FolderExists(Zwischenpfad)
uebertrag2 = Fso.FolderExists(Zielpfad)

Const DeleteReadOnly = True
'_________________________________________________ __________________________________________________ ____________________________
'Existiert Ordner Zwischenpfad?

If uebertrag1 = "Wahr" then 'Wenn ja Inhalt löschen
Set Inhaltloeschen = Fso.GetFolder(Zwischenpfad)
Set Dateien = Inhaltloeschen.Files
For Each Dateien In Dateien
Fso.DeleteFile(Dateien.Path), DeleteReadOnly
Next
Set Dateien = Nothing
Set Inhaltloeschen = Nothing
Set Fso = Nothing
Else 'Wenn Nein Ordner erstellen

Dim f
Set f = Fso.CreateFolder(Zwischenpfad)


end if
'_________________________________________________ __________________________________________________ ____________________________
'Existiert Ordner Zielpfad
If uebertrag2 = "Falsch" then


Dim f2
Set f2 = Fso.CreateFolder(Zielpfad)

end if




'_________________________________________________ __________________________________________________ ____________________________


Set oFso = CreateObject("Scripting.FileSystemObject") 'Öffnet die Logfile-Textdatei
Set oTxtStm = oFso.OpenTextFile(sLogFile, 2, True)

'_________________________________________________ __________________________________________________ ____________________________


oTxtStm.WriteLine "--- Beginn, " & Now & " ---" 'Schreibt Beginnzeit in die Textdatei

'_________________________________________________ __________________________________________________ ____________________________


If oFso.FolderExists(sStartPath) Then 'Schaut ob der Startpfad existiert mit wenn ja gehe weiter wenn Nin sind wir fertig
Call ReadFolder(sStartPath)
Else
oTxtStm.WriteLine "Keine Dateien gefunden"
End If

oTxtStm.WriteLine "--- Ende, " & Now & " ---"
oTxtStm.Close

Set oFso = Nothing
Set oTxtStm = Nothing


'_________________________________________________ __________________________________________________ ____________________________


Sub ReadFolder(sPath) 'Variablen werden initaialisiert
Dim oFld 'nimmt das Ordnerobjekt (Folder) auf
Dim oF 'nimmt das Dateiobjekt (File) auf
Dim nFCount, nErrNum

'_________________________________________________ __________________________________________________ ____________________________


On Error Resume Next 'Bei einem Fehler wird weiter gesucht
'hier wird Fehler 70 ausgelöst, falls kein Zugriff besteht
'Ohne Zugriff ist ein Auflisten der Files natürlich nicht möglich
nFCount = oFso.GetFolder(sPath).Files.Count
nErrNum = Err.Number
Err.Clear
On Error GoTo 0

If nErrNum = 0 Then
'Logeintrag für aktuellen Ordner mit Anzahl der Dateien, falls erwünscht
oTxtStm.WriteLine "Ordner: " & sPath & " - Anz: " & nFCount


'_________________________________________________ __________________________________________________ ____________________________


For Each oF In oFso.GetFolder(sPath).Files 'Für jede Datei im Ordner
'Pfad der Datei in Logfile schreiben


If oF.Type ="JPEG-Bild" then
'Ist Datei.Type ein JPEG-Bild
oFso.CopyFile oF.Path, Zwischenpfad&(i)&("__")&(oF.Name)
i = i + 1 'Wenn ja kopiere es in den Zwischenpfad
end if
oTxtStm.WriteLine Chr(9) & oF.Path 'Jede Datei wird in die LogDatei geschrieben
'... hier evtl. Anweisungen zum Manipulieren der Dateien
Next


'_________________________________________________ __________________________________________________ ____________________________


'rekursiv die Subfolders aufrufen
For Each oFld In oFso.GetFolder(sPath).SubFolders
Call ReadFolder(oFld.Path)
Next

ElseIf nErrNum = 70 Then
'Logeintrag bei Fehler 70, falls erwünscht
oTxtStm.WriteLine "*** Fehler: " & sPath & " - Zugriff verweigert -"
Else
'Logeintrag bei sonst. Fehler, falls erwünscht
oTxtStm.WriteLine "*** Fehler: " & sPath & " - Fehlernummer: " & Err.Number & " -"
End If
End Sub

'_________________________________________________ __________________________________________________ ____________________________






'Datei FERTIG ERSTELLEN 'Datei fertig wird erstellt.
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Textdateierzeugen = Fso.OpenTextFile(sFertig, 2, True)
Textdateierzeugen.WriteLine "--- Fertig, " & Now & " ---"

'_________________________________________________ __________________________________________________ ____________________________

'BilderNamen im Ordner Zwischenspeicher Leerstellen durch _ ersetzen

Set Ordnerumbenennen = Fso.Getfolder(Zwischenpfad)
For each File in Ordnerumbenennen.Files
If InStr(File.Name, " ") Then
File.Name = Replace(File.Name, " ", "_")
End IF
Next



'_________________________________________________ __________________________________________________ ____________________________
'Starten mit Bild verkleinern
Zielpfad = " "& Zielpfad

Set WshShell = WScript.CreateObject("WScript.Shell")
Set ordnerhandle = Fso.Getfolder(Zwischenpfad)

For each dateihandle in ordnerhandle.files 'Für jede Datei (Dateihandle im Ordner (Ordnerhandle.files)

WshShell.run (ImageResize & " -resize 100x100 -quality 75 -strip " & dateihandle.shortpath & Zielpfad & "kleiner__" & dateihandle.name),0, true 'Variablen für ImageMagick die das Bild verkleinern


Next

'_________________________________________________ __________________________________________________ ____________________________
'Inhalt Zwischenspeicher löschen

Set Inhaltloeschen = Fso.GetFolder(Zwischenpfad)
Set Dateien = Inhaltloeschen.Files
For Each Dateien In Dateien
Fso.DeleteFile(Dateien.Path), DeleteReadOnly
Next
Set Dateien = Nothing
Set Inhaltloeschen = Nothing
Set Fso = Nothing
'_________________________________________________ __________________________________________________ ____________________________

Die Pfäde müsst ihr natürlich dementsprechend ändern. Wenn irgendetwas auch einfacher zu realisieren ist bitte sagt bescheid da ich nur selten was mit vbs mache.
Auch würde mich intressieren ob es unter Vista ohne Probleme funktioniert.

PS: Das Script verwendet ein externes Programm um die Bilder zu verkleinern.(http://www.imagemagick.org/script/download.php) Dies sollte man zuerst mit /Silent installieren allerdings ist dies keine saubere Lösung wenns einfacher gehen sollte sagt bescheid.

Gruß err#rhuman