PDA

Archiv verlassen und diese Seite im Standarddesign anzeigen : VBA Frage (shell=



GrazerTourer
12-03-2012, 22:20
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
--- @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...

tommy d. p.
13-03-2012, 07:24
i werd oid! bist narrisch .......:(

GrazerTourer
13-03-2012, 08:18
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