Ausserdem läuft es nicht...
19.04.2003 23:05:22
Ramses
Hallo,weil
A) in der Variablen ".FoundFiles(i)" der Pfad mit enthalten ist. Somit kann die Datei nicht kopiert werden.
B) Der Zieldateiname nicht definiert ist
C) Der Suchpfad nicht definiert ist
D) Der zu suchende Dateityp nicht definiert ist
Option ExplicitSub FileBackup()
Dim i As Long, TotFiles As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String, Zielpfad As String
Dim oldStatus As Variant, dateiform As String
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Zielpfad = InputBox("Geben Sie den Ordner an, in den kopiert werden soll.", "Pfad definieren", "C:\Temp")
If Zielpfad = "" Then Exit Sub
dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
With Application.FileSearch
.LookIn = Suchpfad
'Wenn auch Unterordner durchsucht werden sollen
'den Typ auf TRUE setzen
.SearchSubFolders = False
.Filename = dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For i = 1 To .FoundFiles.Count
gefFile = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\", -1))
FileCopy Suchpfad & "\" & gefFile, Zielpfad & "\" & gefFile
Next i
End If
End With
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
End Sub
Code eingefügt mit Syntaxhighlighter 1.16
Gruss Rainer