Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1736to1740
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

VBA - Dateieigenschaften auslesen

VBA - Dateieigenschaften auslesen
11.02.2020 22:27:49
WalterK
Schönen Abend,
den nachfolgenden Code habe ich schon vor vielen Jahren - glaube ich - in diesem Forum gefunden, Autor ist K.Rola. Damit werden alle Dateieigenschaften der in einem Ordner befindlichen Dateien ausgelesen. Läuft TipTop und m.E. rasend schnell.
2 Fragen hätte ich allerdings dazu:
1.) Kann man den Code so abändern damit er auch alle Dateien von Unterordner mit einschließt und ausliest.
2.) Kann man eine zusätzliche Spalte generieren in der pro Datei der komplette Pfad angegeben wird.
Hier noch der Code:
 Option Explicit
Sub Dateieigenschaften()
'von k.rola
Const STRFOLDER As String = "C:\Users\User\OneDrive\WalterOnedrive\Fotos" 'anpassen
Dim objShell As Object
Dim objFolder As Object
Dim x As Byte
Dim spalte As Integer
Dim zeile As Long
Dim varName, arrHeaders(34)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin..." _
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
spalte = 1
For x = 0 To 33
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
Cells(1, spalte + x) = arrHeaders(x)
Next
Rows(1).Font.Bold = True
zeile = 2
For Each varName In objFolder.Items
For x = 0 To 33
Cells(zeile, spalte + x) = objFolder.GetDetailsOf(varName, x)
Next
zeile = zeile + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Besten Dank, Servus Walter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Dateieigenschaften auslesen
12.02.2020 12:04:11
fcs
Hallo Walter,
hier meine Anpassungen/Ergänzungen.
Ich weiß nicht, ob man die 34 Dateieigenschaften auch irgendwie über das FilescriptingSystem auslesen kann, dann könnte man das Makro etwas einfacher gestalten.
LG
Franz
Option Explicit
Private zeile As Long
Private x As Byte
Private spalte As Integer
Private objShell
Private FSO, FO, FU
Private objFolder
Sub Dateieigenschaften()
'von k.rola
Const STRFOLDER As String = "C:\Users\User\OneDrive\WalterOnedrive\Fotos" 'anpassen
Dim varName, arrHeaders(34)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin. _
.." _
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Clear
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FO = FSO.Getfolder(STRFOLDER)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
spalte = 0
For x = 0 To 33
spalte = spalte + 1
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
Cells(1, spalte) = arrHeaders(x)
Next
spalte = spalte + 1
Cells(1, spalte) = "Pfad"
Rows(1).Font.Bold = True
zeile = 2
Call GetDateieigenschaften
Columns.AutoFit
Range("B2").Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True
MsgBox "Fertig - Dateieigenschaften"
End Sub
Private Sub GetDateieigenschaften()
Dim varName
On Error GoTo Fehler
For Each varName In objFolder.Items
Select Case objFolder.GetDetailsOf(varName, 2) 'Elementtyp
Case "Dateiordner", "Folder"
'Dateiordner nicht listen
Case Else
spalte = 0
For x = 0 To 33
spalte = spalte + 1
Cells(zeile, spalte) = objFolder.GetDetailsOf(varName, x)
Next
spalte = spalte + 1
Cells(zeile, spalte) = objFolder.self.Path
zeile = zeile + 1
End Select
Next
Set FO = FSO.Getfolder(objFolder.self.Path)
For Each FU In FO.subfolders
Set objFolder = objShell.Namespace(FU.Path)
Call GetDateieigenschaften
Next
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Makro: GetDateieigenschaften"
Exit Sub
End Select
End With
End Sub

Anzeige
AW: VBA - Dateieigenschaften auslesen
12.02.2020 13:02:30
WalterK
Hallo Franz,
was kann ich sagen: TipTop und vielen Dank, Du hast mir sehr geholfen.
Schönen Tag noch, Servus Walter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige