Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Verweis auf Windows Scripting Runtime | Herbers Excel-Forum


Betrifft: Verweis auf Windows Scripting Runtime von: Franz W.
Geschrieben am: 07.12.2009 14:24:45

Hallo Fachleute,

ich möchte einen Verweis auf "Windows Scripting Runtime" erstellen. "Windows Scripting Runtime" steht mir aber in meiner Liste der verfügbaren Verweise nicht zur Verfügung: Windows Vista

Was gibt es für Hilfe?

Danke schonmal und Grüße
Franz

  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Anton
Geschrieben am: 07.12.2009 15:12:28

Hallo Franz,

suchst du das hier?


mfg Anton


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Franz W.
Geschrieben am: 07.12.2009 15:22:23

Hallo Anton,

nein, ich suche tatsächlich "Windows Scripting Runtime".

Es geht um folgendes: ich habe u. s. Code bekommen, um die Dateieigenschaften auszulesen. Dazu hieß es, ich müsse einen Verweis zum Windows Scripting Runtime erstellen. Hängt wohl zusammen mit der Datei "scrrun.dll". Die gibt es zwar bei mir, aber der Verweis wird nicht angezeigt.

Grüße
Franz



Sub GetProperties()
    Dim objFSO        As FileSystemObject
    Dim objFile       As File
    
    
    Set objFSO = VBA.Interaction.CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile("c:\temp\1.txt")
    MsgBox objFile.DateCreated
    
    Set objFSO = Nothing
    Set objFile = Nothing

End Sub



  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Rudi Maintaire
Geschrieben am: 07.12.2009 15:40:43

hallo,
den Verweis gibts bei mir auch nicht, aber der Code läuft mit ner kleinen Änderung.

Sub GetProperties()
    Dim objFSO        As Object
    Dim objFile       As Object
    
    
    Set objFSO = VBA.Interaction.CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile("c:\test\test.txt")
    MsgBox objFile.DateCreated
    
    Set objFSO = Nothing
    Set objFile = Nothing

End Sub

Gruß
Rudi


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Franz W.
Geschrieben am: 07.12.2009 15:44:52

Hallo Rudi,

leider nicht! Ich bekomme bei der Zeile:

Set objFile = objFSO.GetFile("c:\test\test.txt")

die Fehlermeldung: "Datei nicht gefunden" - genau wie beim vorigen Code......


Grüße
Franz


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Anton
Geschrieben am: 07.12.2009 17:36:33

Hallo Franz,

kann es sein , dass die Datei "c:\test\test.txt" wirklich nicht existiert?

Code:

Sub GetProperties()  
  Dim objFSO        As Object  
  Dim objFile       As Object  
  Dim Datei         As Object  
 
  Set objFSO = CreateObject("Scripting.FileSystemObject")  
  If Not objFSO.FolderExists("c:\test") Then objFSO.CreateFolder ("c:\test")  
  If Not objFSO.FileExists("c:\test\test.txt") Then  
    Set Datei = objFSO.CreateTextFile("c:\test\test.txt", True)  
    Datei.WriteLine ("Hallo Franz")
    Datei.Close
  End If  
  Set objFile = objFSO.GetFile("c:\test\test.txt")  
  MsgBox objFile.DateCreated
 
  Set objFSO = Nothing  
  Set objFile = Nothing  
End Sub  



mfg Anton


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Franz W.
Geschrieben am: 07.12.2009 17:44:59

Hallo Anton,

gute Frage!! Ich wusste nicht, dass ich die Datei vorher erstellen muss.

Nun aber die Frage: wenn ich vorigen Code laufen lasse, was sollte dann in der Datei drinstehen? Ich habe erwartet, da drin jetzt die Dateieigenschaften zu finden?!?

Grüße
Franz


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Anton
Geschrieben am: 07.12.2009 17:59:23

Hallo Franz,

was sollte dann in der Datei drinstehen? 

da steht jetzt Hallo Franz drin.
da drin jetzt die Dateieigenschaften zu finden?!?

Dateieigenschaften wovon hast da erwartet?

mfg Anton


  

Betrifft: AW: Verweis auf Windows Scripting Runtime von: Franz W.
Geschrieben am: 07.12.2009 18:03:25

Hallo Anton,

tja, das ist wohl das PRoblem, dass ich keinen Verweis auf Windows Scripting Runtime erstellen kann. Denn so wie ich das verstanden habe, sollten nach Ablauf des Makros die Dateieigenschaften aufgelistet sein. Dafür hab ich den Code bekommen mit dem Hinweise auf Windows Scripting Runtime.

Da werd ich wohl noch rum- und versuchen müssen, diesen Verweis zu erstellen.


Grüße
Franz


  

Betrifft: letzte Frage von: Anton
Geschrieben am: 07.12.2009 18:28:55

Hallo Franz,

welche Dateieigenschaften willst Du aufgelistet haben?

mfg Anton


  

Betrifft: AW: letzte Frage von: Franz W.
Geschrieben am: 07.12.2009 18:45:03

hallo Anton,

danke, dass Du Dich meiner annimst :-)))

So wie "FileDateTime" gibt es ja noch unzählige Dateiinformationen, wie z. B. Größe, Typ, Erstelldatum, Änderungsdatum, bei Bildern z. B. das Aufnahmedatum, Kameramodell, Abmessungen, ....... Wo oder wie kann ich nachlesen/-suchen ..... wie man diese anderen Dateiinformationen in einem Code ansprechen kann. Das ist es, wonach ich suche. Eben so wie z. B. "FileDateTime".


Grüße
Franz


  

Betrifft: AW: letzte Frage von: Andre´
Geschrieben am: 07.12.2009 20:17:40

Hallo Franz,
vielleicht hilft Dir dieser Link weiter:

http://clever-forum.de/read.php?11,159057,159057#msg-159057

MFG Andre


  

Betrifft: guck hier von: Anton
Geschrieben am: 07.12.2009 20:19:43

Hallo Franz,

https://www.herber.de/forum/archiv/512to516/t515483.htm#515562

mfg Anton


  

Betrifft: AW: guck hier: nicht ganz von: Franz W.
Geschrieben am: 07.12.2009 21:47:12

Hallo Anton, hallo Anton,

(tut mir leid, ich musste weg). Danke für Eure Hilfen. Dieses Makro von K.Rola hab ich auch. Das listet auch alle GetDetailsOf wunderschön auf.

Damit weiß ich aber immer noch nicht, wie man die einzelnen Details in der VBA-Sprache anspricht. Es gibt in der VBA-Sprache z. B. für das Erstelldatum die Anweisung "FileDateTime"; es gibt bei Fotos "Width" und "Height" (das hab ich aus einem Code von Hans). Entsprechende Anweisungen muss es ja auch für die anderen Dateiinformationen geben. Eine Aufstellung dieser Anweisungen suche ich.


Grüße
Franz


  

Betrifft: Gibt's nicht von: Rudi Maintaire
Geschrieben am: 08.12.2009 10:09:59

Hallo,

Entsprechende Anweisungen muss es ja auch für die anderen Dateiinformationen geben. 

Nein. Die sind ja tw. von installierter Software, Servicepacks etc. abhängig.

Gruß
Rudi


  

Betrifft: AW: Gibt's nicht von: Franz W.
Geschrieben am: 08.12.2009 10:24:43

Hallo Rudi,

danke für die Antwort. Meine Frage nun, wenn es von meinem PC speziell abhängig ist: wie komm ich da ran? Wie kommen andere, die diese Anweisungen nutzen da ran? Kann ich das irgendwie irgendwo auslesen/abfragen/..........???


Grüße
Franz


  

Betrifft: AW: Gibt's nicht von: Rudi Maintaire
Geschrieben am: 08.12.2009 12:30:51

Hallo,
der Code von K.Rola listet dir 34 Eigenschaften auf. Da werden doch die gewünschten bei sein.
Etwas modifiziert:

Public Sub Dateieigenschaften()
  'von K.Rola
  
  Dim objShell As Object, objFolder As Object
  Dim intIndex As Integer, intColumn As Integer, lngRow As Long
  Dim varName, arrItems()
  Dim strFolder As Variant
  
  With Application.FileDialog(4)
     .AllowMultiSelect = False
     .InitialFileName = "c:\"
     .InitialView = 1
     .Title = "Bitte einen Ordner wählen"
     If .Show = -1 Then
        strFolder = .SelectedItems(1)
     End If
  End With

  If strFolder = "" Then
    Exit Sub
  End If
  
  Application.ScreenUpdating = False
  tbListe.Cells.Clear
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(strFolder)
  intColumn = 1
  ReDim arrItems(1 To 34, 1 To 1)
  For intIndex = 0 To 33
    arrItems(intColumn + intIndex, 1) = _
      IIf(objFolder.getdetailsof(varName, intIndex) = "", "x", objFolder.getdetailsof(varName,  _
intIndex))
  Next
  Rows(1).Font.Bold = True
  lngRow = 2
  For Each varName In objFolder.Items
    ReDim Preserve arrItems(1 To 34, 1 To lngRow)
    For intIndex = 0 To 33
      arrItems(intColumn + intIndex, lngRow) = objFolder.getdetailsof(varName, intIndex)
    Next
    lngRow = lngRow + 1
  Next
  With tbListe
    .Cells(1, 1).Resize(lngRow - 1, 34) = WorksheetFunction.Transpose(arrItems)
    .Columns.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub

Gruß
Rudi


  

Betrifft: Tut mir leid,... von: Franz W.
Geschrieben am: 08.12.2009 12:48:32

.... anscheinend schaffe ich es nicht klar zu machen wonach ich suche. Ich suche nicht nach den Ergebnissen. Ich suche nach den einzelnen Anweisungen, einzelne dieser Dateiinformationen abzurufen.

Es gibt die Anweisung "FileDateTime" um das Datum einer Datei abzufragen. Das ist eine eingebaute VBA-Funktion. Mein Frage war nun, gibt es für andere Dateiinformationen ebenfalls solche Funktionen. Und wo finde ich diese???

Interessiert hätte mich das am meisten für Fotos, hier in Bezug z. B. auf das Aufnahmedatum. Denn der Code von K.Rola scheitert, wenn ein *.JPG in einem Bildbearbeitungsprogramm bearbeitet wurde. Dann wird das ursprüngliche Aufnahmedatum nicht mehr angezeigt. Mein Hoffnung war nun, das auf anderem Weg ermitteln zu können. Denn in der JPG-Datei ist diese Information ja nach wie vor enthalten und in jedem Bildbearbeitungsprogramm zu ersehen.


Entschuldigende Grüße
Franz


  

Betrifft: AW: Tut mir leid,... von: Rudi Maintaire
Geschrieben am: 08.12.2009 13:29:08

Hallo,

Denn in der JPG-Datei ist diese Information ja nach wie vor enthalten

nicht unbedingt. Wenn das Aufnahmedatum im Explorer angezeigt werden kann, wird es auch von K.Rolas Code gelesen.

Gruß
Rudi


  

Betrifft: AW: Tut mir leid,... von: Franz W.
Geschrieben am: 08.12.2009 13:41:00

Hallo Rudi,

ja, das ist richtig. Aber auch in diesem Fall ist die Information noch irgendwo in der Datei enthalten. Denn ein Bildbearbeitungsprogramm kann das ursprüngliche Aufnahmedatum unverändert anzeigen.

Hab's grad mal mit Paint Shop Pro getestet: das ursprüngliche Aufnahmedatum heißt hier "Originaldatum und -zeit". Die Frage ist halt, ob das mit Excel irgendwie gefunden und ausgelesen werden kann.


Danke und Grüße
Franz


  

Betrifft: Exif-Daten von Fotos auslesen von: Franz W.
Geschrieben am: 08.12.2009 15:28:22

Hallo Rudi,

ich hab mir mal ein behandeltes Foto im Viewer Irfan-View angesehen: auch dort finden sich noch allerlei Informationen, die Windows und damit der Code von K.Rola nicht zur Verfügung stellen. Sie stehen in den sog. EXIF-Daten.

Könnte es sein, dass diese Daten irgendwie ausgelesen werden können? Sollte ich das mal als eigene Frage ins Forum stellen?


Grüße
Franz


  

Betrifft: AW: Exif-Daten von Fotos auslesen von: Rudi Maintaire
Geschrieben am: 08.12.2009 16:15:57

Hallo,
prinzipiell geht das. Aber: jeder Kamerahersteller schreibt die Daten anders, d.h. das Aufnahmedatum beginnt bei einem anderen Byte. Von daher wird das sehr tricky.

Type TagInfo
  Jahr As String * 4
  deli1 As String * 1
  Monat As String * 2
  deli2 As String * 1
  Tag As String * 2
  deli3 As String * 1
  Stunde As String * 2
  deli4 As String * 1
  Minute As String * 2
  deli5 As String * 1
  Sekunde As String * 2
End Type
  
Function Get_JPG_Shoot_Date(p_FileName) As String
  Dim CurrentTag As TagInfo
   
  ' Datei öffnen
  Open p_FileName For Binary As #1
  i = 37 * 16 + 7 'Startbyte für das Jahr, evtl anpassen
  With CurrentTag
    ' Jahr auslesen
    Get #1, i, .Jahr
         
    ' Einzelne Datumsbestandteile lesen
    Get #1, , .deli1
    Get #1, , .Monat
    Get #1, , .deli2
    Get #1, , .Tag
    Get #1, , .deli3
    Get #1, , .Stunde
    Get #1, , .deli4
    Get #1, , .Minute
    Get #1, , .deli5
    Get #1, , .Sekunde
  
    ' Ausgabeformat definieren und String setzen
    ' Ausgabebeispiel: So, 14. Sep 2003, 12.16 Uhr
    Get_JPG_Shoot_Date = Format(.Tag & "." & .Monat & "." & .Jahr, "DDD") & ", " _
    & .Tag & ". " & Format((.Monat - 1) * 30 + 10, "MMM") & " " & .Jahr & ", " _
    & .Stunde & "." & .Minute & " Uhr"
   
  End With
   
  ' Datei schließen
  Close #1
  
End Function

Sub ttt()
  MsgBox Get_JPG_Shoot_Date("c:\test\test1.jpg")
End Sub

Gruß
Rudi


  

Betrifft: AW: Exif-Daten von Fotos auslesen von: Franz W.
Geschrieben am: 08.12.2009 16:59:07

Hallo Rudi,

ich staun, mal wieder was Ihr alle so könnt. Reinvertiefen werd ich mich später, jetzt will ich erstmal testen. Krieg aber nen Fehler bei den Zeilen:

Get_JPG_Shoot_Date = Format(.Tag & "." & .Monat & "." & .Jahr, "DDD") & ", " _
& .Tag & ". " & Format((.Monat - 1) * 30 + 10, "MMM") & " " & .Jahr & ", " _
& .Stunde & "." & .Minute & " Uhr"

Da kommt die fehlermeldung: "Typen unverträglich" .............


Grüße
Franz


  

Betrifft: AW: Exif-Daten von Fotos auslesen von: Anton
Geschrieben am: 08.12.2009 17:14:09

Hallo Franz,

Du kannst IrfanView dafür benutzen:

Code:

Sub bild_aufgenommen_am()
  Dim iview As String, bild  
  Dim fso As Object, temp As Object, zeile As String    
  iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe" 'anpassen
  bild = Application.GetOpenFilename("JPG Bilder (*.jpg), *.jpg")  
  If bild <> False Then  
    Shell iview & " " & bild & " /fullinfo /info=C:\temp.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)  
    Do While temp.AtEndOfStream <> True    
      zeile = temp.ReadLine
      If InStr(1, zeile, "DateTime") <> 0 Then Exit Do    
    Loop
    temp.Close
    zeile = Replace(zeile, "DateTime", "Bild aufgenommen am")
    MsgBox zeile
    Kill "C:\temp.txt"
    Set fso = Nothing  
  End If  
End Sub  



mfg Anton


  

Betrifft: AW: Exif-Daten von Fotos auslesen von: Franz W.
Geschrieben am: 08.12.2009 17:48:13

Hallo Anton,

ich wiederhol nochmal schnell das mit dem Staunen, was ich vorhin bei Rudi geschrieben hab........ :-))) . IrfanView in Excel einsetzen.............!!!


Aber zum Code: muss ich hier auch wieder die Datei temp.txt vorher erstellen? Bei der Zeile

Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)

kommt die Fehlermeldung: "Datei nicht gefunden".


Aber weiter unten wird sie ja wieder gekillt.......???


Grüße
Franz


  

Betrifft: temp.text erstellt IrfanView von: Anton
Geschrieben am: 08.12.2009 18:07:00

Hallo Franz,

probier's so:

Code:

Sub bild_aufgenommen_am()
  Dim iview As String, bild, WshShell As Object    
  Dim fso As Object, temp As Object, zeile As String    
  iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe" 'anpassen
  bild = Application.GetOpenFilename("JPG Bilder (*.jpg), *.jpg")  
  If bild <> False Then  
    Set WshShell = CreateObject("WScript.Shell")  
    WshShell.Run iview & " " & bild & " /fullinfo /info=C:\temp.txt", , True
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)  
    Do While temp.AtEndOfStream <> True    
      zeile = temp.ReadLine
      If InStr(1, zeile, "DateTime") <> 0 Then Exit Do    
    Loop
    temp.Close
    zeile = Replace(zeile, "DateTime", "Bild aufgenommen am")
    MsgBox zeile
    Kill "C:\temp.txt"
    Set fso = Nothing  
    Set WshShell = Nothing  
  End If  
End Sub  



mfg Anton


  

Betrifft: AW: temp.text erstellt IrfanView von: Franz W.
Geschrieben am: 08.12.2009 18:19:49

Hallo Anton,

da meckert er jetzt bei der Zeile:

WshShell.Run iview & " " & bild & " /fullinfo /info=C:\temp.txt", , True

"Die Methode 'Run' für das Objekt 'IWshShell3' ist fehlgeschlagen"


Grüße
Franz


  

Betrifft: Pfad zum IrfanView von: Anton
Geschrieben am: 08.12.2009 19:07:41

Hallo Franz,

hast Du Pfad zum IrfanView angepasst?Wenn ja,wie sieht er aus?

mfg Anton


  

Betrifft: AW: Pfad zum IrfanView von: Franz W.
Geschrieben am: 08.12.2009 19:11:49

Hallo Anton,

hier die Pfadangabe:

iview = "C:\Program Files\IrfanView\i_view32.exe" 'anpassen

Fehlermeldung: "Die Methode 'Run' für das Objekt 'IWshShell3' ist fehlgeschlagen"



Ändere ich die Pfadangabe in:

iview = "C:\Programme\IrfanView\i_view32.exe" 'anpassen


kommt bei:
Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)

wieder: "Datei nicht gefunden"



Grüße
Franz


  

Betrifft: AW: Pfad zum IrfanView von: Anton
Geschrieben am: 08.12.2009 19:19:46

Hallo Franz,

wo ist denn jetzt IrfanView installiert:hier "C:\Program Files\IrfanView\i_view32.exe"
oder hier "C:\Programme\IrfanView\i_view32.exe" ?

mfg Anton


  

Betrifft: AW: Pfad zum IrfanView von: Franz W.
Geschrieben am: 08.12.2009 19:30:57

sorry Anton, wollte nicht verwirren.....


hier "C:\Program Files\IrfanView\i_view32.exe"


Grüße
Franz

P.S.: muss jetzt leider raus zum Arbeiten. Werd erst sehr spät oder morgen wieder da sein können. Auf jeden Fall vielen Dank für Deine Hilfen!!!


  

Betrifft: noch eine Variante von: Anton
Geschrieben am: 08.12.2009 19:55:33

Hallo Franz,

Code:

Sub bild_aufgenommen_am()
  Dim iview As String, bild, WshShell As Object    
  Dim fso As Object, temp As Object, zeile As String    
  iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe" 'anpassen
  bild = Application.GetOpenFilename("JPG Bilder (*.jpg), *.jpg")  
  If bild <> False Then  
    Set WshShell = CreateObject("WScript.Shell")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    iview = fso.getfile(iview).ShortPath
    WshShell.Run iview & " " & bild & " /fullinfo /info=C:\temp.txt", , True
    Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)  
    Do While temp.AtEndOfStream <> True    
      zeile = temp.ReadLine
      If InStr(1, zeile, "DateTime") <> 0 Then Exit Do    
    Loop
    temp.Close
    zeile = Replace(zeile, "DateTime", "Bild aufgenommen am")
    MsgBox zeile
    Kill "C:\temp.txt"
    Set fso = Nothing  
    Set WshShell = Nothing  
  End If  
End Sub  



mfg Anton


  

Betrifft: "Datei nicht gefunden" von: Franz W.
Geschrieben am: 08.12.2009 23:32:40

Hallo Anton,

auch diese Variante sagt bei "Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)" : "Datei nicht gefunden"


Leider auch nicht

Grüße
Franz


  

Betrifft: AW: "Datei nicht gefunden" von: Anton
Geschrieben am: 09.12.2009 15:19:52

Hallo Franz,

vllt liegt das an der Version von IrfanView? Ich habe 4.25 mit allen Plugins.

mfg Anton


  

Betrifft: hmm - auch nicht....... von: Franz W.
Geschrieben am: 09.12.2009 17:52:07

Hallo Anton,

okay, hatte 4.10. Hab jetzt aber aufgerüstet auf 4.25 und alle PlugIns dazu. Aber unverändert kommt bei

Set temp = fso.OpenTextFile("C:\temp.txt", 1, False)

die Meldung: "Datei nicht gefunden"...............


Grüße
Franz


  

Betrifft: AW: hmm - auch nicht....... von: Anton
Geschrieben am: 09.12.2009 18:24:19

Hallo Franz,

was passiert, wenn Du diesen Code ausführst?

Code:

Sub test()
  Dim iview As String, bild, WshShell As Object    
  Dim fso As Object  
  iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe" 'anpassen
  bild = Application.GetOpenFilename("JPG Bilder (*.jpg), *.jpg")  
  If bild <> False Then  
    Set WshShell = CreateObject("WScript.Shell")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    iview = fso.getfile(iview).ShortPath
    WshShell.Run iview & " " & bild & " /fullinfo /info=C:\temp.txt", , True
    WshShell.Run "notepad C:\temp.txt"
    Set fso = Nothing  
    Set WshShell = Nothing  
  End If  
End Sub  



mfg Anton


  

Betrifft: AW: hmm - auch nicht....... von: Franz W.
Geschrieben am: 09.12.2009 18:31:19

Hallo Anton,

es geht der Editor mit einem Fragefenster:

"
Die Datei C:\temp.txt kann nicht gefunden werden.
Möchten Sie eine neue Datei erstellen?

"

mehr nicht: nach Bejahen bleibt der Editor auf..........

Grüße
Franz


  

Betrifft: AW: hmm - auch nicht....... von: Anton
Geschrieben am: 09.12.2009 18:39:08

Hallo Franz,

kannst Du direkt unter C:\ Textdateien erstellen(Berechtigung)?

mfg Anton


  

Betrifft: hihi - gute Frage von: Franz W.
Geschrieben am: 09.12.2009 18:45:28

Hallo Anton,

damit hast Du's gefunden: nein, kann ich nicht! UND ICH WEISS NICHT WARUM !! Ist nämlich mein PC, bin der einzige hier dran und somit eigentlich der Administrator! Dachte ich zumindest.......

So, damit hab ich Deinen vorigen Code auf D:\ umgeschrieben - und schon geht's!!!!!!!!! Du bist Spitze - find ich echt toll!!!


Vielen Dank und Grüße
Franz


  

Betrifft: !!! aber......... von: Franz W.
Geschrieben am: 09.12.2009 18:56:34

Hallo Anton,

aber auch hier mit wird das Änderungsdatum ausgegeben, NICHT das ursprüngliche Original-Aufnahmedatum !!


Grüße
Franz


  

Betrifft: AW: !!! aber......... von: Anton
Geschrieben am: 09.12.2009 19:10:34

Hallo Franz,

starte noch mal den letzten Code und guck in der D:\temp.txt, ob da die Daten richtig sind.
Oder poste hier den Inhalt dieser Datei.

mfg Anton


  

Betrifft: Sub test von: Franz W.
Geschrieben am: 09.12.2009 23:59:53

Hallo Anton,

wenn Du als letzten den "Sub Test" meinst: ja, die Daten sind richtig!

Es geht der Editor auf mit temp.txt mit den Bildinformationen und den EXIF-Daten (bin begeistert!), s. u.: ja, jetzt wär's toll, wenn die einzeln auszuwählen wären, um sie dann im Sheet aufzulisten.

U. a. steht in der Zeile 29 (Leerzeile mitgezählt) "DateTimeOriginal", das dem ursprünglichen Originaldatum entspricht.


Staunende Grüße
Franz




[IMG_6524.JPG]
File name = IMG_6524.JPG
Directory = D:\aaa Bilder\- aaa für Exceltest\TEST - fuer myJPEGs umbenennen\
Compression = JPEG
Resolution = 180 x 180 DPI
Image dimensions = 2736 x 3648 Pixels (9.98 MPixels) (3:4)
Print size = 38.6 x 51.5 cm; 15.2 x 20.3 inches
Color depth = 16,7 Millions (24 BitsPerPixel)
Number of unique colors = 177596
Disk size = 1.23 MB (1.290.593 Bytes)
Current memory size = 28.56 MB (29.942.824 Bytes)
File date/time = 04.11.2009 / 14:46:00

- EXIF -
Make - Canon
Model - Canon DIGITAL IXUS 90 IS
Orientation - Top left
XResolution - 180
YResolution - 180
ResolutionUnit - Inch
Software - Paint Shop Pro Photo 11,20
DateTime - 2009:11:04 14:45:59
YCbCrPositioning - Centered
ExifOffset - 246
ExposureTime - 1/60 seconds
FNumber - 2.80
ISOSpeedRatings - 80
ExifVersion - 0220
DateTimeOriginal - 2009:09:23 22:21:02
DateTimeDigitized - 2009:09:23 22:21:02
ComponentsConfiguration - YCbCr
CompressedBitsPerPixel - 5 (bits/pixel)
ShutterSpeedValue - 1/60 seconds
ApertureValue - F 2.80
ExposureBiasValue - 0.00
MaxApertureValue - F 2.80
MeteringMode - Multi-segment
Flash - Flash fired, auto mode
FocalLength - 6.20 mm
UserComment
FlashPixVersion - 0100
ColorSpace - sRGB
ExifImageWidth - 2736
ExifImageHeight - 3648
InteroperabilityOffset - 1020
FocalPlaneXResolution - 15136.93
FocalPlaneYResolution - 15116.02
FocalPlaneResolutionUnit - Inch
SensingMethod - One-chip color area sensor
FileSource - DSC - Digital still camera
CustomRendered - Normal process
ExposureMode - Auto
White Balance - Auto
DigitalZoomRatio - 1.00 x
SceneCaptureType - Portrait
Thumbnail:
Compression - 6 (JPG)
XResolution - 0.01
YResolution - 0.01
ResolutionUnit - Inch
JpegIFOffset - 1186
JpegIFByteCount - 5424
YCbCrPositioning - Co-Sited

- IPTC -
Record Version - 2.0




---


  

Betrifft: hab's kapiert von: Franz W.
Geschrieben am: 10.12.2009 10:45:32

Hallo Anton,

Es gibt Hilfen, da tät ich den Stifter gerne mal kurz drücken! Das hier gehört ganz dringend dazu :-))!! So wie Du Dich da reingekniet hast, und mir nebenbei gleich noch ein paar andere Dinge beigebracht hast! Vielen Dank dafür!!

Hab nun schon kapiert, wie das geht mit den einzelnen Abfragen. Hab mir Deinen Code "bild_aufgenommen_am" nochmal in Ruhe angesehen. Und daraus wird ja wirklich klar, wie die einzelnen Eigenschaften abzufragen sind. Jetzt die Dateien nicht einzeln aus dem Öffnen-Fenster holen, sondern mit einer Schleife die bereits in einem Sheet aufgelisteten Dateien durchgehen - klappt wunderbar. Das Ergebnis trag ich dann in die Spalte daneben ein. UND BIN GLÜCKLICH :-)))!!! Auch Kameramodell, falls manchmal erforderlich.......... Toll!!!!

Als Nebeneffekt hab ich grad noch gemerkt, dass sich, wohl weil das Datum als Text eingetragen wird, wunderbar nach dieser Datumsspalte sortieren läßt (ohne die Sortierprobleme, die es sonst oft gibt mit Datumsangaben).

EINE FRAGE WÄRE JETZT NUR NOCH, ob sich das Ganze noch beschleunigen ließe. Ich nehme an, dass das deswegen langsam ist, weil jedes Mal eine txt-Datei erstellt und hinterher wieder geschlossen und gelöscht werden muss. Ob sich das auch in eine Variable einlesen ließe, aus der man dann ebenfalls die einzelnen Informationen gezielt wieder rausholen kann? Unten mein momentaner Testcode.......


Und eine Nicht-Excel-Frage vielleicht noch: hast Du eine Idee, warum ich auf C:\ nicht schreiben kann? Warum mir da die Rechte fehlen? Kann ich da was tun? Installieren z. B. kann ich ja auch alles.............. Oder ist das von ACER gesperrt und soll so sein - warum auch immer ......???


Ganz begeisterte Grüße
Franz


Sub Bild_Informationen()
'Dez. 2009: von Anton aus Herber-Forum: https://www.herber.de/forum/archiv/1120to1124/t1122218.htm

  Dim iview As String, bild, WshShell As Object
  Dim fso As Object, temp As Object, zeile As String
  Dim i As Long, LoLetzte As Long
  If Range("A65536") = "" Then LoLetzte = Range("A65536").End(xlUp).Row _
      Else: LoLetzte = 65536

  
  iview = "C:\Program Files\IrfanView\i_view32.exe"     'ANPASSEN
  'bild = Application.GetOpenFilename("JPG Bilder (*.jpg), *.jpg")
  For i = 1 To LoLetzte
      bild = Cells(i, 1)
      If bild <> False Then
        Set WshShell = CreateObject("WScript.Shell")
        Set fso = CreateObject("Scripting.FileSystemObject")
        iview = fso.getfile(iview).ShortPath
        WshShell.Run iview & " " & bild & " /fullinfo /info=d:\temp.txt", , True
        Set temp = fso.OpenTextFile("d:\temp.txt", 1, False)
        Do While temp.AtEndOfStream <> True
          zeile = temp.ReadLine
          If InStr(1, zeile, "DateTimeOriginal - ") <> 0 Then Exit Do
          'If InStr(1, zeile, "Make") <> 0 Then Exit Do
        Loop
        temp.Close
        zeile = Replace(zeile, "DateTimeOriginal - ", "")
        'MsgBox zeile, 64
        Cells(i, 2) = zeile
        Kill "d:\temp.txt"
        Set fso = Nothing
        Set WshShell = Nothing
      End If
  Next i
End Sub



  

Betrifft: und noch ein Problem ergibt sich von: Franz W.
Geschrieben am: 10.12.2009 14:52:56

Hallo Anton,

jetzt stellt sich noch ein anderes Problem raus: obwohl das Ganze schon funktioniert hat, passiert es immer wieder - und ich weiß diesmal nicht, was ich dagegen tun kann - dass IrfanView eine Fehlermeldung bringt, es könne den Dateiheader nicht lesen. Obwohl es mit den Dateien in der Liste sehr wohl schon funktioniert hat. Mal konnte ich es wieder gängig machen, indem ich den Rechner neu gestartet hab. Ein anderes Mal konnte ich abhelfen, in dem ich durch alle Zellen der Spalte A gegangen bin mit F2 + Enter. Danach ging's wieder. Aber manchmal bringt auch das nichts, und es kommt immer wieder.

Wenn ich die Datei aus dem Explorer raus öffne, kann ich in IrfanView natürlich mit "I" die Informationen und die EXIF-Daten einsehen.

Hast Du da eine Idee? Kann man das abfangen? Hab die Datei mal hochgeladen:


https://www.herber.de/bbs/user/66485.xls


Danke schonmal und Grüße
Franz


  

Betrifft: AW: und noch ein Problem ergibt sich von: Anton
Geschrieben am: 10.12.2009 15:45:17

Hallo Franz,

IrfanView braucht nicht nur Dateiname IMG_6524.JPG , sondern kompleten Pfad zur Datei
D:\aaa Bilder\- aaa für Exceltest\TEST - fuer myJPEGs umbenennen\IMG_6524.JPG.

mfg Anton


  

Betrifft: AW: und noch ein Problem ergibt sich von: Franz W.
Geschrieben am: 10.12.2009 15:49:38

Hallo Anton,

kapiere, drum geht's mal und mal nicht: wenn ich vorher im Öffnen-Dialog den Ordner gewäht habe, dann kappts.


Super, danke schonmal
Franz


  

Betrifft: AW: und noch ein Problem ergibt sich von: Anton
Geschrieben am: 10.12.2009 16:10:33

Hallo Franz,

probier sowas:

Code:

Option Explicit

Sub Bild_Informationen()  
  Dim iview As String, bild, WshShell As Object    
  Dim fso As Object, temp As Object, zeile As String    
  Dim i As Long, LoLetzte As Long  
  Dim AppShell As Object  
  Dim BrowseDir As Variant  
  Dim Pfad As String  
  Set AppShell = CreateObject("Shell.Application")  
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)  
  If Not BrowseDir Is Nothing Then    
    Pfad = BrowseDir.items().Item().Path
    i = 1
    iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe"     'ANPASSEN
    Set WshShell = CreateObject("WScript.Shell")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    iview = fso.getfile(iview).ShortPath
    For Each bild In fso.GetFolder(Pfad).Files    
      Cells(i, 1) = bild
      Application.StatusBar = bild
      WshShell.Run iview & " " & bild & " /fullinfo /info=d:\temp.txt", , True
      Set temp = fso.OpenTextFile("d:\temp.txt", 1, False)  
      Do While temp.AtEndOfStream <> True    
        zeile = temp.ReadLine
        If InStr(1, zeile, "DateTimeOriginal - ") <> 0 Then Exit Do      
       'If InStr(1, zeile, "Make") <> 0 Then Exit Do
      Loop
      temp.Close
      zeile = Replace(zeile, "DateTimeOriginal - ", "")
      Cells(i, 2) = zeile
      Kill "d:\temp.txt"
      i = i + 1
    Next
    Set fso = Nothing  
    Set WshShell = Nothing  
    Application.StatusBar = False
  End If  
End Sub  



mfg Anton


  

Betrifft: AW: und noch ein Problem ergibt sich von: Franz W.
Geschrieben am: 10.12.2009 16:47:06

Hallo Anton,

danke erstmal für den Vorschlag, werd ihn mal in Ruhe durchgehen. Zum einen wird in Spalte "A" der gesamte Pfad mit eingetragen. Aber da hab ich ja schon was von Dir, den Namen ohne Pfad einzutragen.

Und: es dauert genau so lange wie meine Variante. Und da ich die Dateinamen schon im Sheet stehen habe, war meine Hoffnung, könnte es sich vielleicht beschleunigen lassen, wenn nicht jedesmal im Hintergrund eine Datei erstellt und wieder gelöscht werden muss.


Grüße

Franz


  

Betrifft: etwas schnellere Variante von: Anton
Geschrieben am: 10.12.2009 17:29:20

Hallo Franz,

Code:

Option Explicit

Sub Bild_Informationen()  
  Dim iview As String, bild, WshShell As Object    
  Dim fso As Object, temp As Object, zeile As String    
  Dim i As Long, LoLetzte As Long  
  Dim AppShell As Object  
  Dim BrowseDir As Variant  
  Dim Pfad As String  
  Set AppShell = CreateObject("Shell.Application")  
  Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)  
  If Not BrowseDir Is Nothing Then    
    Pfad = BrowseDir.items().Item().Path
    i = 2
    iview = "C:\Programme\Bildbearbeitung\IrfanView4.22\i_view32.exe"     'ANPASSEN
    Set WshShell = CreateObject("WScript.Shell")  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    iview = fso.getfile(iview).ShortPath
    Cells(1, 1) = Pfad
    WshShell.Run iview & " " & Pfad & "\*.jpg /fullinfo /info=d:\temp.txt", , True
    Set temp = fso.OpenTextFile("d:\temp.txt", 1, False)  
    Do While temp.AtEndOfStream <> True    
      zeile = temp.ReadLine
      If InStr(1, zeile, "[") <> 0 Then  
        Cells(i, 1) = Mid(zeile, 2, Len(zeile) - 2)
      End If  
      If InStr(1, zeile, "DateTimeOriginal - ") <> 0 Then    
        Cells(i, 2) = Replace(zeile, "DateTimeOriginal - ", "")
        i = i + 1
      End If  
    Loop
    temp.Close
    Kill "d:\temp.txt"
    Set fso = Nothing  
    Set WshShell = Nothing  
  End If  
End Sub  




mfg Anton


  

Betrifft: AW: etwas schnellere Variante von: Franz W.
Geschrieben am: 10.12.2009 17:39:29

Hallo Anton,

ja, geht bei meiner Kiste bei 30 Bildern immerhin spürbar um 15 Sek. schneller: 35 statt 50 Sek.

Genauer beschätigen kann ich mich leider wieder erst morgen, melde mich dann nochmal rück........


Herzlichen Dank auf jeden Fall schonmal und Grüße
Franz


Beiträge aus den Excel-Beispielen zum Thema "Verweis auf Windows Scripting Runtime"