Option Explicit
'err.raise 1, "Achtung!", "для запуска закоментировать строку генерации ошибки"
'1) Задать папки для поиска в массив aFolders, например "C:\","E:\"
'2) задать расширения файлов в массив aExtensions, например "mp3","avi","wma"
'3) задать путь и файл для логирования LogFileName1 , например "d:\temp\i.txt"
'см. дальше по тексту...
'Сценарий сканирует указанные каталоги и
'удаляет в нем файлы с указанными расширениями
'
'
Dim LogFileName1
'dim NameFileOfMessage
dim TextOfMessage
Dim aFolders 'массив каталогов
Dim aExtensions 'массив расширений файлов
dim file1
dim FileOfMessage
'1) Задать папки для поиска в массив aFolders, например aFolders = Array("C:\","E:\")
aFolders = Array("D:\")
'2) задать расширения файлов в массив aExtensions, например aExtensions = Array( "mp3","avi","wma")
aExtensions = Array( "id","nsf")
Dim fso
'3) задать путь и файл для логирования LogFileName1 , например LogFileName1 = CStr("d:\temp\i.txt")
LogFileName1 = CStr("c:\Log_Delete_Incoming.txt")
'
'4) пункт убран
'
'5)текст сообщения, которое будет в файле в папке где был удалён файл
TextOfMessage = CStr("Администрация предупреждает: ")
Set fso = CreateObject("Scripting.FileSystemObject")
Set file1 = fso.OpenTextFile(LogFileName1,8,true)
Dim i
file1.WriteLine "----------- начало поиска --------------" & cstr(Date()) & "|" & cstr(Time())
For i = 0 To UBound(aFolders)
If fso.FolderExists(aFolders(i)) Then
on error resume next
Err.Clear
Dim folder
Set folder = fso.GetFolder(aFolders(i))
Dim file
For Each file In folder.Files
if Err then
file1.WriteLine "---> " & cstr(Date()) & "|" & cstr(Time()) &"!!! ->!Ошибка при доступе к папке!<- " &folder
exit for
End If
If IsKnowExtensions(file) Then
Set FileOfMessage = fso.OpenTextFile(folder+"\"+file.name+".txt",8,true)
FileOfMessage.WriteLine (TextOfMessage)
FileOfMessage.WriteLine ("файл '"& file.name & "' изъят до выяснения обстоятельств...")
FileOfMessage.close
file.Delete True
end if
Next
dim subFolder
For Each subFolder In folder.SubFolders
if Err then
exit for
end if
ScanSubFolder subFolder
Next
end if
Next
file1.WriteLine "----------- конец поиска --------------" & cstr(Date()) & "|" & cstr(Time())
file1.close
Function IsKnowExtensions(file)
Dim strExtensions
strExtensions = fso.GetExtensionName(file.Path)
Dim i
For i = 0 To UBound(aExtensions) '- 1
If ucase(strExtensions) = ucase(aExtensions(i)) Then
'msgbox "!"
file1.WriteLine (cstr(Date()) & "|" & cstr(Time()) &" был Удалён : " & file.Path )
IsKnowExtensions = True
Exit Function
End If
Next
IsKnowExtensions = False
End Function
Sub ScanSubFolder(folder)
Dim file
on error resume next
Err.Clear
For Each file In folder.Files
if Err then
file1.WriteLine "---> " & cstr(Date()) & "|" & cstr(Time()) &"!!! ->!Ошибка при доступе к папке!<- " &folder
Err.Clear
exit sub
end if
If IsKnowExtensions(file) Then
Set FileOfMessage = fso.OpenTextFile(folder+"\"+file.name+".txt",8,true)
FileOfMessage.WriteLine (TextOfMessage)
FileOfMessage.WriteLine ("файл '"& file.name & "' изъят до выяснения обстоятельств...")
FileOfMessage.close
file.Delete true
end if
Next
Dim subFolder
For Each subFolder In folder.SubFolders
ScanSubFolder subFolder
Next
End Sub
|
)
