AW: Löschen aller Dateil im Auswahlverzeichnis
18.11.2012 13:20:10
ransi
HAllo Lemmi
Die Dateiein in den PApierkorb zu schieben ist nicht einfach.
Einen Ordner zuer stellen in den du die Originaldateien kopierst ist einfacher.
Teste mal:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Const DATENSICHERUNG = "C:\Deine_Datensicherung\" 'Anpassen
Public Sub Aufruf()
Dim objShell As Object
Dim objFolder As Object
Dim objItem As Object
Dim fso As Object
Set objShell = CreateObject("Shell.Application")
With objShell
Set objFolder = .BrowseForFolder(0&, "Was soll ich machen?", 0)
End With
If Not objFolder Is Nothing Then
Set objItem = objFolder.Self
'####
MakeSureDirectoryPathExists DATENSICHERUNG 'Verzeichniß erstellen
Set fso = CreateObject("Scripting.FileSystemObject")
fso.copyfolder objItem.Path, DATENSICHERUNG, True 'Den originalordner in die Datensicherung kopieren
Set fso = Nothing
'####
Else: Exit Sub
End If
Clear_Folders objItem.Path, True 'True wenn die Unterordner geleert werden sollen.
'Sonst False oder weglassen.
End Sub
Public Sub Clear_Folders(Suchordner, Optional sbfolds As Boolean = False)
Dim fso As Object
Dim datei
Dim objFile
Dim Unterordner
Set fso = CreateObject("Scripting.FileSystemObject")
Set datei = fso.getfolder(Suchordner)
On Error Resume Next
Select Case sbfolds
Case True
For Each Unterordner In datei.subfolders
For Each objFile In Unterordner.Files
fso.deletefile (objFile)
Next
Clear_Folders Unterordner, True
Next
Case False
For Each objFile In fso.getfolder(Suchordner).Files
fso.deletefile (objFile)
Next
End Select
Set fso = Nothing
Set datei = Nothing
End Sub
ransi