Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Aufnahedatum jpg mit .getdetailsof

Aufnahedatum jpg mit .getdetailsof
26.05.2020 00:29:52
claudia
Hallo,
ichhabe einProgramm geschrieben, das mir rekursiv alle Ordner & Unterordner durchgeht & die Dateien in das Aufnahme.Datum umbenennt. Manchmal stht es in created, manchmal in lastmodified oder auch in lastacessed. (nehme einfach das kleinste, das passt schon. Jetzt bin ich jedoch auf mehrere Folder gestossen, wo all diese 3 Felder über den gesamten Folder einheitlich mit dem 7-12-2019 gefüllt ist, das aufnahmedatum (das auch im Explorer unter "Datum" angezeigt wird) zu verschiedenen Datenin in dem Vorjahren liegt. Habe mich ein bisschen schlau gemacht, dieses Datum lässt sich nicht so bequem wie die anderen extrhieren. sondern man muss dieerweiterten Dateiinfos auslesen. Geht anscheinend über .getdetailsof, mein Feld steht in POsition 12.
Habe es wohl etwas naiv rinfach so versucht:
test = oFolder.getdetailsof(oFile, 12)
Erhalte jedoch die Fehermeldung, dass das Objekt oder die Methode nicht unterstütz wird.
Weiss jemand, wie ich das Programm modifizieren müsste?
Herzlichen Dank,
Claudia
So sieht der ganze code aus:
Option Explicit
Option Compare Text
Private sRootPath As String
Private lRowCounter As Long
Private oSheet As Object
'Start der Routine: Call MWDateienMitUnterordnernAuslesen
Public Sub MWDateienMitUnterordnernAuslesen()
sRootPath = Range("Dateipfad").Value
Set oSheet = Sheets("pfad")
Call ReadSubFolder(sRootPath)
Set oSheet = Nothing
MsgBox "Done"
End Sub
Private Sub ReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oSHELL As Object
Dim oFile As Object
Dim strEXT, neu, test As String
Dim objFolder As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
For Each oSubFolder In oFolder.SubFolders
For Each oFile In oSubFolder.Files
test = oFolder.getdetailsof(oFile, 12)
strEXT = "." & oFSO.getextensionname(oFile)
If oFile.datecreated 

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aufnahedatum jpg mit .getdetailsof
26.05.2020 08:29:46
Martin
Hallo Claudia,
getdetailsof ist keine Methode des FileSystemObject, sondern von Shell. Leider habe ich jetzt keine Zeit und kennzeichne den Beitrag deshalb als offen.
Hier ein kurzer Beispielcode:
Public Sub test()
Const STRFOLDER As String = "D:Eigene DateienEigene Excelbeispiele" 'Pfad anpassen
Dim objShell As Object, objFolder As Object
Dim bytIndex As Byte, intColumn As Integer, lngRow As Long
Dim varName, arrHeaders(37)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 1
For bytIndex = 0 To 37
arrHeaders(bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
Cells(1, intColumn + bytIndex) = arrHeaders(bytIndex)
Next
Rows(1).Font.Bold = True
lngRow = 2
For Each varName In objFolder.Items
For bytIndex = 0 To 37
Cells(lngRow, intColumn + bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
Next
lngRow = lngRow + 1
Next
Columns.AutoFit
Set objShell = Nothing
Set objFolder = Nothing
Application.ScreenUpdating = True
End Sub 
Viele Grüße
Martin
Anzeige
AW: Aufnahedatum jpg mit .getdetailsof
26.05.2020 14:46:39
volti
Hallo Claudia,
teste mal den nachfolgend aufgeführten Erstversion-Code, der auch das Aufnahmedatum aus den Dateien extrahieren soll.
Ich hatte mich früher auch mal im Zuge meines Fototools damit auseinandergesetzt, über die getdetailsof-Funktion mein Aufnahmedatum und den Kameratyp zu ermitteln.
Leider wurde mir immer nur die Bezeichnung des Feldes, aber nie der Wert (also 'Aufnahmedatum' statt '01.01.2011 12:00") herausgegeben.
Ich hatte dann entnervt aufgegeben und das ganze zu Fuß ermittelt....
Dank Deiner Anfrage habe ich mich mal wieder etwas damit beschäftigt.
Übrigens ist nicht immer ein Aufnahmedatum oder die Kameraangabe in einer jpg-Datei vorhanden. Nach Bearbeitung so einer Datei kann das schon mal weg sein.
Auch muss der Type "Exif" vorhanden sein.
Darüber hinaus wundere ich mich, dass die getdetailsof-Funktion und auch die anderen Datum's offensichtlich keine Sekunden herausgeben, obwohl diese vorhanden sind.
Aber vielleicht reicht Dir dieses ja schon zum Weitermachen, oder ich habe was falsch gemacht.

Private Sub ReadSubFolder(ByVal sPath As String)
  Dim oFSO        As Object
  Dim oFolder     As Object
  Dim oSubFolder  As Object
  Dim oShell      As Object
  Dim oFile       As Object
  Dim strEXT, neu
  Dim sAufnahmedatum As String
  Dim objFolder   As Object
  Dim oFileItem   As Object
  Dim oFileFolder As Object
 
  Set oShell = CreateObject("Shell.Application")
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(sPath)
     
  For Each oSubFolder In oFolder.SubFolders
       
      For Each oFile In oSubFolder.Files
                 
'Aufnahmedatum extrahieren
          Set oFileFolder = oShell.Namespace(sPath & "\" & oSubFolder.Name)
          Set oFileItem = oFileFolder.ParseName(oFile.Name)
          sAufnahmedatum = oFileFolder.getdetailsof(oFileItem, 12)
          If Len(sAufnahmedatum) > 1 Then
             sAufnahmedatum = Replace(sAufnahmedatum, Left$(sAufnahmedatum, 1), "")
             sAufnahmedatum = Left$(sAufnahmedatum, 11) & Right$(sAufnahmedatum, 5)
          End If
'Ende Aufnahmedatum extrahieren
          strEXT = "." & oFSO.getextensionname(oFile)
          If oFile.datecreated < oFile.datelastmodified _
             And oFile.datecreated < oFile.datelastmodified Then
                 neu = oSubFolder & "\" & Format(oFile.datecreated, "YYYYMMDD hhmmss") & strEXT
          Else
                 If oFile.datelastaccessed < oFile.datelastmodified _
                    And oFile.datelastaccessed < oFile.datecreated Then
                      neu = oSubFolder & "\" & Format(oFile.datelastaccessed, "YYYYMMDD hhmmss") & strEXT
                 Else
                      neu = Format(oFile.datelastmodified, "YYYYMMDD hhmmss")
                      neu = oSubFolder & "\" & Format(oFile.datelastmodified, "YYYYMMDD hhmmss") & strEXT
                 End If
          End If
'         On Error Resume Next
'         MsgBox oFile & " " & neu
          Name oFile As neu
                 
          On Error GoTo 0
      Next oFile
             
'Alle Unterverzeichnisse verarbeiten (rekursiv)
      Call ReadSubFolder(oSubFolder.Path)
         
  Next oSubFolder
 
  Set oFSO = Nothing
  Set oFile = Nothing
  Set oFolder = Nothing
  Set oSubFolder = Nothing
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Aufnahedatum jpg mit .getdetailsof
26.05.2020 20:01:38
volti
Hallo Claudia,
hier ein Update....
Ich habe mir zwischenzeitlich eine Funktion gebastelt, der Du einfach Pfad und Dateinamen übergibst.
Da sind noch Kamera und Pixel drin, kann man ja rausnehmen. Wichtig ist nur, dass die Null-Zeichen, die bei Zahlenwerten mitkommen, ersetzt werden.
Bei Übernahme in ein Excelfeld macht das Excel wohl selbständig.
Könnte so in Deinem "alten" code aufgerufen werden (ungetestet)
test=GetFileDetails(sPath & "\" & oSubFolder.Name,oFile.name)

Dim sKamera As String, sPixel As String, sAufnahmedatum As String
Function GetFileDetails(sPath As String, sFile As String) As String
'Funktion ermittelt einige Datei-Parameter und bereinigt sie um unnötige Zeichen
 Dim oFile As Object, sFirma As String, T As String, i As Integer
 With CreateObject("Shell.Application").Namespace(CVar(sPath))
   Set oFile = .ParseName(sFile)
'32 Firma, 30=Kamera-Typ, 31=Auflösung, 12 Aufnahmedatum
   sFirma = .getdetailsof(oFile, 32)
   sKamera = .getdetailsof(oFile, 30)
   If Not sKamera Like Split(sFirma)(0) & "*" Then
      sKamera = sFirma & " " & sKamera
   End If
   sPixel = .getdetailsof(oFile, 31)
   sPixel = Mid$(sPixel, 2, Len(sPixel) - 2)
   T = .getdetailsof(oFile, 12)
   sAufnahmedatum = ""
   For i = 2 To Len(T)
    If Mid$(T, i, 1) <> Chr$(0) Then sAufnahmedatum = sAufnahmedatum & Mid$(T, i, 1)
   Next i
 End With
 GetFileDetails = sAufnahmedatum        'Aufnahmedatum zurückgeben
End Function
viele Grüße
Karl-Heinz

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige