AW: Ordnerinhalt auflisten
26.04.2005 09:25:10
Stefan
Hallo Sonja!
Hiermit kannst Du schon mal einen Ordner angeben und die Dateien ausgeben. Mit der Größe der Dateien musst Du dann nochmal weiterfragen.
Private Sub CommandButton1_Click()
Dim pfad As String, such As String
Dim Text As String, xxl As String
Dim i As Integer, y As Integer, z As Integer
Dim info As Integer, x As Integer, anz As Integer
Dim fs
Set fs = Application.FileSearch
pfad = InputBox("Geben Sie den Pfad ein", , "C:\Eigene Dateien")
If pfad = "" Then Exit Sub
With fs
.LookIn = pfad
.Filename = "*.*"
'wenn der Pfad nicht existiert Programm abbrechen
If Dir(pfad, vbDirectory) = "" Then
MsgBox "Falsche Pfadangabe ! Das Verzeichnis" & _
vbCrLf & "' " & pfad & " '" & _
vbCrLf & "existiert nicht !", _
vbExclamation, "Fehlermeldung"
Exit Sub
End If
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
z = Len(.LookIn)
such = "\"
Cells(2, 2) = pfad & " " & .FoundFiles.Count & " Dateien"
y = 3
For i = 1 To .FoundFiles.Count
Cells(y, 2) = .FoundFiles(i)
Text = Cells(y, 2)
anz = Len(Cells(y, 2))
such = "\"
For x = 1 To anz
info = InStr(info + 1, Text, such)
If info = 0 Then GoTo weiter
Cells(y, 2) = Right(Text, anz - info)
xxl = Cells(y, 2)
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(y, 2), Address:=Text, _
TextToDisplay:=xxl
End With
Next x
weiter:
y = y + 1
Next i
Columns("B:B").AutoFit
Else
MsgBox "Keine Dateien gefunden"
End If
End With
With Columns("B:B").Font
.Name = "Arial"
.FontStyle = "Standard"
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
With Cells(2, 2).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.ColorIndex = xlAutomatic
.Bold = True
End With
End Sub
+++++++++++++++++++++++++++++++++++++++++
Viel Spaß damit
LG Stefan