Zum Inhalt springen

VBA Frage (shell=


 Teilen

Empfohlene Beiträge

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]

Link zu diesem Kommentar
Auf anderen Seiten teilen

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

Link zu diesem Kommentar
Auf anderen Seiten teilen

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.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung jetzt entfernen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

 Teilen

×
×
  • Neu erstellen...