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