Bilder sortieren nach Aufnahmedatum

Sub auflisten() Dim iCounter As Integer Dim sPath As String sPath = ThisWorkbook.Path Columns("B:B").ClearContents With Application.FileSearch .NewSearch '.FileType = msoFileTypeAllFiles .Filename = "*.jpg" .LookIn = sPath '.SearchSubFolders=True .Execute If .FoundFiles.Count = 0 Then Beep MsgBox "Keine Dateien gefunden!" Else For iCounter = 1 To .FoundFiles.Count Cells(iCounter + 3, 2) = Mid(.FoundFiles(iCounter), InStrRev(.FoundFiles(iCounter), "\") _ + 1) Next iCounter End If End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
vielleicht hilft das weiter:

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
Dim wksListe As Worksheet
Set wksListe = Sheets("Dateiliste")
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
wksListe.Cells.Clear
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
intColumn = 1
ReDim arrItems(1 To 201, 1 To 1)
For intIndex = 0 To 200
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 201, 1 To lngRow)
For intIndex = 0 To 200
arrItems(intColumn + intIndex, lngRow) = objFolder.getdetailsof(varName, intIndex)
Next
lngRow = lngRow + 1
Next
With wksListe
.Cells(1, 1).Resize(lngRow - 1, 201) = WorksheetFunction.Transpose(arrItems)
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi

Hallo Franz,

Sub dateien_auflisten()
Dim objShell As Object, objFolder As Object
Dim BrowseDir, varName, lngRow As Long
Set objShell = CreateObject("Shell.Application")
Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
If Not BrowseDir Is Nothing Then
Cells.Clear
Set objFolder = objShell.Namespace(BrowseDir.self.Path)
Cells(1, 1) = objFolder.GetDetailsOf(, 0)
Cells(1, 2) = objFolder.GetDetailsOf(, 29)
Cells(1, 3) = BrowseDir.self.Path
Rows(1).Font.Bold = True
lngRow = 2
For Each varName In objFolder.items
If Right(UCase(varName), 3) = "JPG" Then
Cells(lngRow, 1) = varName
Cells(lngRow, 2) = objFolder.GetDetailsOf(varName, 29)
lngRow = lngRow + 1
End If
Next
Set objFolder = Nothing
End If
Set objShell = Nothing
End Sub

mfg Anton

Beliebteste Forumthreads (12 Monate)

Bilder sortieren nach Aufnahmedatum

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bilder sortieren nach Aufnahmedatum

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread