Dateien aus Ordner löschen

Wolfgang · 2007-12-12T07:41:55+00:00

Hallo, ich würde gerne aus untenstehendem Pfad/Verzeichnis im Unterordner KDTemp sämtliche Dateien mit der Endung ".tmp" löschen; dabei soll allerdings immer die jüngste Datei bestehen bleiben. Wäre so etwas möglich? - Das Verzeichnis ist über Username gesteuert, daher der untenstehende Vorspann zum Verzeichnis. Danke schon jetzt für die Rückmeldungen. Gruß - Wolfgang 'Pfad Dim strUser As String strUser = Environ("Username") strUser = Trim$(Replace(strUser, ".GST", "")) Sheets("Daten").Activate With ActiveSheet.QueryTables.Add(Connection:= _ 'Verzeichnis C:\Dokumente und Einstellungen\" & strUser & "\Lokale Einstellungen\Temp\KDTemp\.tmp",

Hallo Wolfgang,
müssen denn die .tmp Dateien wirklich gelöscht werden oder machst du das nur, um an die eine zu kommen die über bleibt. Denn du könntest, mit einem leicht abgewandelten Code von mir, ja auch einfach die neuste tmp Datei suchen und diesen Dateinamen für den Datenimport nutzen.
Denn erstens braucht das löschen Zeit und Rechnerkapazität und zweitens mögen einige Virenscanner Kill Befehle in Makros garnicht gerne.
Wenn du auch löschen willst dann könnte das in etwa so aussehen:


Function KillOldTemps(strPath As String) As String
Dim strKillFile As String, strTemp As String
Dim datLastDate As Date
Dim myFileSystemObject, myFiles
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each myFiles In myFileSystemObject.GetFolder(strPath).Files
If UCase(myFileSystemObject.GetExtensionName(strPath & "\" & myFiles.Name)) = "TMP" Then
If (myFiles.DateCreated > datLastDate) And (datLastDate  "00:00:00") Then
Kill strKillFile
datLastDate = myFiles.DateCreated
strKillFile = strPath & "\" & myFiles.Name
strTemp = myFiles.Name
ElseIf (myFiles.DateCreated  "00:00:00") Then
Kill strPath & "\" & myFiles.Name
Else
datLastDate = myFiles.DateCreated
strKillFile = strPath & "\" & myFiles.Name
strTemp = myFiles.Name
End If
End If
Next myFiles
KillOldTemps = strTemp
End Function

Und dann deins, den Pfad "C:\WINDOWS\Temp" mußt du natürlich noch auf deinen Pfad ändern !!!
strUser = Environ("Username")
strUser = Trim$(Replace(strUser, "GST", ""))
Sheets("Daten").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Dokumente und Einstellungen\" & strUser & "\Lokale Einstellungen\Temp\KDTemp\" & KillOldTemps("C:\WINDOWS\Temp"), Destination:=Range("A1"))
ChDrive "C"
Habe ich jetzt auf die schnelle nicht getestet, wenn nicht läuft kann ich morgen früh nochmal drüber schauen.
Gruß Heiko
PS: Rückmeldung wäre nett !

Moin Wolfgang,
dann so:


Public Sub TestT()
Dim strUser As String, strPath As String, strhelp As String
' Dein Teil für den UserNamen
strUser = Environ("Username")
strUser = Trim$(Replace(strUser, "GST", ""))
' Zusammenbauen des Pfades aus Vorgabepfad und UserName
strPath = "C:\WINDOWS\Temp\" & strUser & "\Temp"
If Dir(strPath, vbDirectory) = "" Then
MsgBox "Das angegebene Verzeichnis existiert nicht!", vbCritical
Exit Sub
End If
Sheets("Daten").Activate
' Nun noch das TEXT; davor & Aufruf der Function die die neuste Tmp Datei als String zurückgibt. _
strhelp = FindNewestTemp(strPath)
If strhelp  "" Then
strPath = "TEXT;" & FindNewestTemp(strPath)
Else
MsgBox "Es wurde keine TMP Datei im angegebenen Verzeichnis gefunden!", vbCritical
Exit Sub
End If
' Und nun nur noch importieren, fertig !!!
With ActiveSheet.QueryTables.Add(Connection:=strPath, Destination:=Range("A1"))
.Refresh
' ChDrive "C"
End With
End Sub


Public Function FindNewestTemp(strPath As String) As String
Dim strFile As String
Dim datNewestDate As Date
Dim myFileSystemObject, myFiles
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each myFiles In myFileSystemObject.GetFolder(strPath).Files
If UCase(myFileSystemObject.GetExtensionName(strPath & myFiles.Name)) = "TMP" Then
If myFiles.DateCreated > datNewestDate Then
datNewestDate = myFiles.DateCreated
strFile = myFiles.Name
End If
End If
Next myFiles
If strFile  "" Then
FindNewestTemp = strPath & strFile
Else
FindNewestTemp = ""
End If
End Function

Gruß Heiko
PS: Rückmeldung wäre nett !

Forumthread: Dateien aus Ordner löschen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Dateien aus Ordner löschen

Forumthread: Dateien aus Ordner löschen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread