GrazerTourer Geschrieben 12. März 2012 Teilen Geschrieben 12. März 2012 Hallo, Wieso öffnet sich in meinem Beispiel zwar kurz die das Fenster der Konsole, es passiert aber nix?! x = Shell("C:\WINDOWS\system32\convert.exe " & file.Name & " -resize 1280x960 " & ordner & "\@eaDir\" & file.Name & "\SYNOPHOTO_THUMB_XL.jpg", vbNormalFocus) (convert kommt von Imagemagick - ist installiert und funktioniert. Der gesamte erstellte String ist richtig. Wenn ich ihn in eine *.bat Datei schreibe, diese dann manuell ausführe, klappt alles. Wenn ich die *.bat Datei aus VBA ausführe, geht's genauso nicht. Das Konsolenfenster ght kurz auf, aber das war's...). Vielleicht hat ja jemand eine Idee. Achja, das Imagemagick ActiveX Control will leider auch nicht so recht funktionieren. Wer will, hier das gesamte Beipiel: Global n As Integer Sub DateiInformationen_auslesen() n = 1 PFAD = InputBox("Startverzeichnis") With ThisWorkbook.Worksheets(1) Call list_files(CreateObject("Scripting.FileSystemObject").GetFolder(PFAD)) End With End Sub Sub list_files(ordner As Variant) Dim file As Variant Dim subordner As Variant iseadir = InStr(CStr(ordner), CStr("@eaDir")) If iseadir = 0 Then MkDir (ordner.Path & "\@eaDir") End If For Each file In ordner.Files MkDir (ordner & "\@eaDir\" & file.Name) Open file For Binary Access Read Lock Write As #1 x = Shell("C:\WINDOWS\system32\convert.exe " & file.Name & " -resize 1280x960 " & ordner & "\@eaDir\" & file.Name & "\SYNOPHOTO_THUMB_XL.jpg", vbNormalFocus) Close #1 Cells(n, 1) = file.Name Cells(n, 2) = ordner.Path n = n + 1 Next For Each subordner In ordner.SubFolders If (subordner.Attributes And 4) = 0 Then '/System-Ordner/ 'hier sollte man den Ordner erstellen Call list_files(subordner) End If Next End Sub Sollte jemand eine Idee haben wie man folgendes direkt in einer bat Datei lösen kann, wäre das natürlich eleganter als über VBA oder VBS. Wenn der convert Aufruf aus VB funktionieren würde, wäre ich allerdings schon fertig und total zufrieden! 1. Startordner auswählen 2. In jedem Unterordner in dem es *.jpg Dateien gibt einen Unterordner @eaDir erstellen (solange es den nicht schon gibt) 3. Im Unterordner @eaDir pro *.jpg einen Ordner erstellen der gleich heißt wie das *.jpg 4. in diesem Ordner (der wie das Bild heißt) pro jpg aus dem Ursprungsverzeichnis 4 convert Befehle ausführen und die Thumbnails hier ablegen Es muss also für jede jpg Datei in einem Unterordner @eaDir einen Ordner mit selben Namen wie die jpg Datei geben, in welchem sich 4 Thumbnail Bilder selbiger Datei befinden (die 4 heißn immer gleich) Vielleicht hat ja jemand eine Idee Beispiel für den Verzeichnisbaum. Ordner1 | --- 1.jpg --- 2.jpg --- 3.jpg --- Ordner2 | --- a.jpg --- b.jpg --- c.jpg Das Ergebnis soll sein: Ordner1 | --- 1.jpg --- 2.jpg --- 3.jpg [color="#FF0000"] --- @eaDir | --- 1.jpg(Ordnername - keine Datei!) | ---SYNOPHOTO_THUMB_XL.jpg ---SYNOPHOTO_THUMB_L.jpg ---SYNOPHOTO_THUMB_M.jpg ---SYNOPHOTO_THUMB_S.jpg --- 2.jpg(Ordner) | ---SYNOPHOTO_THUMB_XL.jpg ---SYNOPHOTO_THUMB_L.jpg ---SYNOPHOTO_THUMB_M.jpg ---SYNOPHOTO_THUMB_S.jpg --- 3.jpg(Ordner) | ---SYNOPHOTO_THUMB_XL.jpg ---SYNOPHOTO_THUMB_L.jpg ---SYNOPHOTO_THUMB_M.jpg ---SYNOPHOTO_THUMB_S.jpg | --- Ordner2 | a.jpg(Ordnername - keine Datei!) | ---SYNOPHOTO_THUMB_XL.jpg ---SYNOPHOTO_THUMB_L.jpg ---SYNOPHOTO_THUMB_M.jpg ---SYNOPHOTO_THUMB_S.jpg usw...[/color] Zitieren Link zu diesem Kommentar Auf anderen Seiten teilen Mehr Optionen zum Teilen...
tommy d. p. Geschrieben 13. März 2012 Teilen Geschrieben 13. März 2012 i werd oid! bist narrisch ....... Zitieren Link zu diesem Kommentar Auf anderen Seiten teilen Mehr Optionen zum Teilen...
GrazerTourer Geschrieben 13. März 2012 Autor Teilen Geschrieben 13. März 2012 Hab's gelöst... das ImageMagick Objekt funktioniert ein bisserl "komisch". Wen's interessiert: Global n As Integer Sub DateiInformationen_auslesen() n = 1 PFAD = InputBox("Startverzeichnis") With ThisWorkbook.Worksheets(1) Call list_files(CreateObject("Scripting.FileSystemObject").GetFolder(PFAD)) End With End Sub Sub list_files(ordner As Variant) Dim file As Variant Dim subordner As Variant Dim imMgk As Object Set imMgk = CreateObject("ImageMagickObject.MagickImage.1") iseadir = InStr(CStr(ordner), CStr("@eaDir")) If iseadir = 0 Then MkDir (ordner.Path & "\@eaDir") End If For Each file In ordner.Files thumbnail = InStr(CStr(file.Name), CStr("SYNOPHOTO_THUMB")) If thumbnail = 0 Then MkDir (ordner & "\@eaDir\" & file.Name) Open file For Binary Access Read Lock Write As #1 ' x = Shell("C:\WINDOWS\system32\convert.exe " & file.Name & " -resize 1280x960 " & ordner & "\@eaDir\" & file.Name & "\SYNOPHOTO_THUMB_XL.jpg", vbNormalFocus) imMgk.Convert CStr(file), "-resize", "1280x960", ordner & "\@eaDir\" & CStr(file.Name) & "\SYNOPHOTO_THUMB_XL.jpg" imMgk.Convert CStr(file), "-resize", "800x600", ordner & "\@eaDir\" & CStr(file.Name) & "\SYNOPHOTO_THUMB_L.jpg" imMgk.Convert CStr(file), "-resize", "320x240", ordner & "\@eaDir\" & CStr(file.Name) & "\SYNOPHOTO_THUMB_M.jpg" imMgk.Convert CStr(file), "-resize", "120x90", ordner & "\@eaDir\" & CStr(file.Name) & "\SYNOPHOTO_THUMB_S.jpg" Close #1 ' Cells(n, 1) = file.Name ' Cells(n, 2) = ordner.Path ' n = n + 1 Else End If Next For Each subordner In ordner.SubFolders If (subordner.Attributes And 4) = 0 Then '/System-Ordner/ 'hier sollte man den Ordner erstellen Call list_files(subordner) End If Next End Sub Zitieren Link zu diesem Kommentar Auf anderen Seiten teilen Mehr Optionen zum Teilen...
Empfohlene Beiträge
Dein Kommentar
Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.