Thema: Verweis auf Windows Scripting Runtime | Herbers Excel-Forum

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

Hallo Franz,
suchst du das hier?

mfg Anton

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

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

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

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

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

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

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

Hallo Franz,
welche Dateieigenschaften willst Du aufgelistet haben?
mfg Anton

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

Hallo Franz,
vielleicht hilft Dir dieser Link weiter:
http://clever-forum.de/read.php?11,159057,159057#msg-159057
MFG Andre

Hallo Franz,
https://www.herber.de/forum/archiv/512to516/t515483.htm#515562
mfg Anton

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

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

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

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

.... 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

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

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

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

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

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

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

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

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

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

Hallo Franz,
hast Du Pfad zum IrfanView angepasst?Wenn ja,wie sieht er aus?
mfg Anton

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

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

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!!!

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

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

Hallo Franz,
vllt liegt das an der Version von IrfanView? Ich habe 4.25 mit allen Plugins.
mfg Anton

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

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

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

Hallo Franz,
kannst Du direkt unter C:\ Textdateien erstellen(Berechtigung)?
mfg Anton

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

Hallo Anton,
aber auch hier mit wird das Änderungsdatum ausgegeben, NICHT das ursprüngliche Original-Aufnahmedatum !!
Grüße
Franz

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

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
---

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

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

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

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

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

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

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

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