Sub DateienEinlesen1()
Range("A3:A20").ClearContents
On Error GoTo Fehler
Dim FileArray()
Dim i%, n%
Dim Ordner$, Extension$, dName$
Ordner = "C:\Seriendruck"
'Extension = InputBox("Dateityp:", , "*.xls")
ChDrive Left(Ordner, 1)
ChDir Ordner
dName = Dir(Extension)
Do While dName <> ""
n = n + 1
ReDim Preserve FileArray(1 To n)
FileArray(n) = dName
dName = Dir()
Loop
For i = 1 To n
ActiveSheet.Cells(i + 2, 1) = FileArray(i)
Next
Exit Sub
Fehler:
MsgBox ("Ein Fehler ist aufgetreten." & Chr(13) & "Wahrscheinlich existiert das Verzeichnis:" & Chr(13) & "C:Seriendruck" & Chr(13) & "nicht!")
End Sub
und Modul
Sub Alles_loeschen()
Call DeleteFolder("C:\Seriendruck")
End Sub
Public Sub DeleteFolder(sFolder As String)
Dim fso As New FileSystemObject
Dim Text As String
Dim Antwort
Text = "Wollen Sie den Ordner " & sFolder & vbCrLf & _
"wirklich löschen?" & vbCrLf & vbCrLf & _
"Alle darin befindlichen Dateien gehen verloren."
On Error GoTo DeleteFolder_ERROR
If fso.folderexists(sFolder) Then
Antwort = MsgBox(Text, vbQuestion + vbYesNo, "Ordner löschen")
If Antwort = vbYes Then
fso.DeleteFolder (sFolder)
Else
MsgBox "Der Ordner wurde nicht gelöscht."
End If
Else
Err.Raise 10001, "Verzeichnis existiert nicht"
End If
Exit Sub
DeleteFolder_ERROR:
MsgBox Err.Description
End Sub
Das Problem ist sobald ich das erste Makro ausführe, geht das zweite nicht mehr richtih, denn es löscht keine Unterordner mehr - die anderen Dateien in diesem Ordner schon.
Solltet ihr eine Beispielarbeitsmappe brauchen einfach bescheid sagen
Danke schonmal
Steffen