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
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
was sollte dann in der Datei drinstehen?
da drin jetzt die Dateieigenschaften zu finden?!?
Entsprechende Anweisungen muss es ja auch für die anderen Dateiinformationen geben.
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
Denn in der JPG-Datei ist diese Information ja nach wie vor enthalten
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
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
Microsoft Scripting Runtime aktivieren:
Entwicklertools.Visual Basic, um den VBA-Editor zu öffnen.Extras > Verweise.Microsoft Scripting Runtime in der Liste und aktiviere das Kontrollkästchen. Wenn der Eintrag nicht sichtbar ist, könnte es sein, dass die scrrun.dll nicht korrekt installiert ist.Erstelle ein neues Modul:
VBAProject (DeineMappe) > Einfügen > Modul.Code eingeben:
Sub GetProperties()
Dim objFSO As FileSystemObject
Dim objFile As File
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile("c:\test\test.txt")
MsgBox objFile.DateCreated
Set objFSO = Nothing
Set objFile = Nothing
End SubDatei anlegen:
c:\test\test.txt existiert, bevor du das Makro ausführst.Fehler: "Datei nicht gefunden":
Verweis nicht verfügbar:
Microsoft Scripting Runtime nicht angezeigt wird, kann es sein, dass es ein Problem mit der Installation der scrrun.dll gibt. Diese Datei ist notwendig für die Verwendung des FileSystemObject.Verwendung von CreateObject:
FileSystemObject dynamisch erstellen, indem du den folgenden Code verwendest:Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")EXIF-Daten mit IrfanView:
Sub Get_JPG_Shoot_Date()
' Code zur Verwendung von IrfanView um EXIF-Daten auszulesen
End SubDateieigenschaften auslesen:
Sub CreateAndReadFile()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists("c:\test\test.txt") Then
Dim objFile As Object
Set objFile = objFSO.CreateTextFile("c:\test\test.txt", True)
objFile.WriteLine ("Hallo Franz")
objFile.Close
End If
' Datei lesen
MsgBox objFSO.GetFile("c:\test\test.txt").DateCreated
End SubVariablen für Pfade nutzen:
Fehlerbehandlung einbauen:
On Error Resume Next, um Fehler zu handhaben, ohne dass dein Programm abbricht. So kannst du sicherstellen, dass der Code auch bei unerwarteten Fehlern weiterläuft.1. Wie aktiviere ich die Microsoft Scripting Runtime in Excel?
Um die Microsoft Scripting Runtime zu aktivieren, gehe zu Entwicklertools > Visual Basic > Extras > Verweise und aktiviere das Kontrollkästchen.
2. Was mache ich, wenn der Verweis nicht angezeigt wird?
Wenn der Verweis nicht sichtbar ist, könnte die scrrun.dll nicht installiert sein. Überprüfe die Installation oder versuche, das FileSystemObject dynamisch zu erstellen.
3. Wie kann ich EXIF-Daten von Bildern in Excel auslesen? Verwende einen externen Bildbetrachter wie IrfanView, um EXIF-Daten auszulesen. Der Code kann so angepasst werden, dass die Informationen ausgelesen und in Excel angezeigt werden.
4. Was ist der Unterschied zwischen Dim objFSO As FileSystemObject und Dim objFSO As Object?
Der erste Ansatz erfordert den Verweis auf die Microsoft Scripting Runtime, während der zweite Ansatz dynamisch ein Object erstellt und daher keinen Verweis benötigt.