Office: Verzeichnisstruktur auslesen und auflisten

Venom · 2. Juni 2010

Hallo zusammen,
ich suche nach einem Quellcode der in einem bestimmten Ordner die Unterordner einliest und auflistet ohne die darin in enthaltenen Dateien zu listen.
Finde im Netz nur mit Dateien und wenn ich den anpasse macht er leider gar nichts mehr
Wenn möglich wäre schön wenn das Erstelldatum mit aufgeführt wird des ORdners.

Vllt kann mir wer helfen?

Gruß
Venom

:)

jinx · 3. Juni 2010

Moin, Venom,

Ansatz siehe Ordner eines Verzeichnisses in ListBox übernehmen für den Bereich der ComboBox.

Venom · 3. Juni 2010

Hi Jiinx
danke für die Seite
Habe jetzt eine Combobox die die Unterordner beinhaltet
Code:

Private Sub UserForm_Initialize()
Dim iCounter As Integer
Dim sDir As String, sfile As String
Dim Wscript As Application
Dim objWMIService As Object

'Hier auflisten
If Right(Range("B1").Value, 1) "\" Then
Range("B1").Value = Range("B1").Value & "\"
End If

sDir = Range("B1").Value
Me.Caption = "Start: " & sDir
sfile = Dir(sDir & "*.*", vbDirectory)

Do While sfile ""
sfile2 = sfile
If sfile = "." Or sfile = ".." Then
ElseIf (GetAttr(sDir & sfile) And _
vbDirectory) = vbDirectory Then
cboFolders.AddItem sfile
End If
sfile = Dir
Loop

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie bekomme ich nun das Erstelldatum?

Hatte den folgenden Code gefunden, leider kann ich das mit dem o.g. nicht zusammenführen!
Code:

Sub ReadProperties()
Dim Wscript As Application
Dim objWMIService As Object
Dim colFolders As Object
Dim objFolder As Object
Dim strComputer As String, sPath As String
sPath = Range("B1").Value
sPath = WorksheetFunction.Substitute(sPath, "\", "\\")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFolders = objWMIService. _
ExecQuery("Select * from Win32_Directory where name = '" & sPath & "'")
For Each objFolder In colFolders
With objFolder
Cells(3, 2).Value = .Archive
Cells(4, 2).Value = .Caption
Cells(5, 2).Value = .Compressed
Cells(6, 2).Value = .CompressionMethod
Cells(7, 2).Value = .CreationDate
Cells(8, 2).Value = .Encrypted
Cells(9, 2).Value = .EncryptionMethod
Cells(10, 2).Value = .Hidden
Cells(11, 2).Value = .InUseCount
Cells(12, 2).Value = .LastAccessed
Cells(13, 2).Value = .LastModified
Cells(14, 2).Value = .Name
Cells(15, 2).Value = .Path
Cells(16, 2).Value = .Readable
Cells(17, 2).Value = .System
Cells(18, 2).Value = .Writeable
End With
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Könnte mir wer helfen?
Woebi mir CreationDate reichen würde!

Backowe · 3. Juni 2010

Hi,

vielleicht etwas einfacher.

Code:

' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************

Option Explicit

Function ZeigeDateiInfo(sfile)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(sfile)
ZeigeDateiInfo = f.DateCreated
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

' ************************************************************** ' Modul: UserForm1 Typ = Userform ' ************************************************************** Option Explicit Private Sub UserForm_Initialize() Dim iCounter As Integer Dim sDir As String, sfile As String Dim Wscript As Application Dim objWMIService As Object 'Hier auflisten If Right(Range("B1").Value, 1) <> "\" Then Range("B1").Value = Range("B1").Value & "\" End If sDir = Range("B1").Value Me.Caption = "Start: " & sDir sfile = Dir(sDir & "*.*", vbDirectory) Do While sfile <> "" If sfile = "." Or sfile = ".." Then ElseIf (GetAttr(sDir & sfile) And _ vbDirectory) = vbDirectory Then cbofolders.AddItem sfile & " --- " & Left(ZeigeDateiInfo(sDir & sfile), 10) End If sfile = Dir Loop End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code eingefügt mit:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

_anton_ · 3. Juni 2010

Hallo ,

oder so:
Code:
Private Sub UserForm_Initialize()
Dim fso, o1, s, sDir
sDir = Range("B1").Value
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(sDir) Then Exit Sub
Me.Caption = "Start: " & sDir
s = 0
With Me.ComboBox1
.ColumnCount = 2
For Each o1 In fso.GetFolder(sDir).SubFolders
.AddItem o1.Name
.List(s, 1) = fso.GetFolder(o1).DateCreated
s = s + 1
Next
.ListIndex = 0
.ColumnWidths = "100;100"
End With
Set fso = Nothing
End Sub

mfg Anton

Venom · 4. Juni 2010

Traumhaft
es läuft
Merci

Schönes Wochenende

Office: Verzeichnisstruktur auslesen und auflisten

Verzeichnisstruktur auslesen und auflisten

Verzeichnisstruktur auslesen und auflisten

Verzeichnisstruktur auslesen und auflisten

Verzeichnisstruktur auslesen und auflisten - Similar Threads - Verzeichnisstruktur auslesen auflisten

Teile aus einem qrcode string auslesen

VBA Auslesen von Strings und erstellen neuer Zeilen in einer Tabelle

aktuelles Alter aus Geburtsdatum auslesen und runde Geburtstage markieren

Verzeichnisstruktur von Excel in Win Explorer übernehmen

Word 2016 - Fehler Inhaltsverzeichnis, wenn 2. Ebene fehlt

Outlook und T-Online abstimmen

Mails in Explorer-Verzeichnisstruktur automatisch speichern