Dateiennamenindex kleiner als maximaler löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Claus,

probier mal das.
Auf eigene Verantwortung. Im Makro ist noch eine Sicherung eingebaut, wenn du diese entfernst ist das ganze Ding scharf !! ;-))

Sub Delete_old_Fileindex()
Dim i As Long, TotFiles As Long
Dim gefFile As String
Dim Suchpfad As String, Index As String, DateiForm As String
Dim oldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Index = InputBox("Geben Sie den Index an der NICHT gelöscht werden soll", "Dateierweiterung", "d")
If Index = "" Then Exit Sub
DateiForm = InputBox("Bitte die Endung der Dateiform definieren", "Dateierweiterung", "cdd")
If DateiForm = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
With Application.FileSearch
    .LookIn = Suchpfad
    .SearchSubFolders = False
    .Filename = DateiForm
    If .Execute() > 0 Then
        TotFiles = .FoundFiles.Count
        Application.StatusBar = "Total " & TotFiles & " gefunden"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            If Mid(gefFile, 18, 1) <> Index And Right(gefFile, 3) = DateiForm Then
                'Das Hochkomma vor Kill entfernen und das Makro ist scharf !!!
                'Es gibt keine Möglichkeit mehr die Datei wieder herzustellen
                'Kill gefFile
                MsgBox "Kill: " & gefFile
            End If
            Debug.Print gefFile
        Next i
    End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Hi Leute!

Ich brauche nochmal Hilfe. Irgendwas klemmt noch in dem Code, den ich wie folgt abgeändert habe. Die Mid-Funktion findet nicht den Index an der dritten Stelle - jedenfalls passiert nichts mit den Files. Diese habe ich in einen Testordner kopiert und und folgendermaßen benannt:

123a456.txt
123b456.txt
123c456.txt

Danke für jede Hilfe im voraus...Claus

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Sub CommandButton1_Click()
Dim i As Long, TotFiles As Long
Dim gefFile As String
Dim oldStatus As Variant
Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer

'Dateinamen einlesen
'Pfad auswählen
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim udtBI As BrowseInfo

'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, sPath
'free the block of memory
CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

'Dateiendung eingeben
sPattern = InputBox( _
prompt:="Dateiendung:", Default:="*.*")
sFile = Dir(sPath & sPattern)

Mark = InputBox( _
prompt:="Index, der NICHT gelöscht werden soll:", Default:="c")

With Application.FileSearch
.LookIn = sFile
.SearchSubFolders = False
.Filename = sPattern
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For i = 1 To .FoundFiles.Count
gefFile = .FoundFiles(i)
If Mid(gefFile, 3, 1) <> Mark And Right(gefFile, 1) = sPattern Then

Kill gefFile

MsgBox "Kill: " & gefFile
End If
Debug.Print gefFile
Next i
End If

End With

Beliebteste Forumthreads (12 Monate)

Dateiennamenindex kleiner als maximaler löschen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread