Показать сообщение отдельно
Старый 22.07.2015, 13:51   #16
Lyuker
Пользователь
 
Пол:Мужской
Регистрация: 18.02.2010
Сообщений: 36
Репутация: 3
По умолчанию Re: автоматическое удаление файла по истечению определенного времени

Цитата:
Сообщение от fmike Посмотреть сообщение
Dim fso

Function DelFiles(Folder)
'*** Функция удаляет все файлы в папке Folder старше N дней

N = 5
Set f = fso.GetFolder(Folder)

Set fc = f.Files
For Each f1 in fc
Set file = fso.GetFile(f1)
diff = DateDiff("d", file.DateCreated, date,0, 0)
If diff > N Then
file.delete
end if
Next

End Function

Function DelSubFolders(SubFolder)
'*** Функция перебирает подпапки в папке SubFolder,
'*** вызывает функцию удаления файлов и удаляет пустые подпапки

'Dim f, f1, fc, ff, ff1, fc1, file, diff

Set f = fso.GetFolder(SubFolder)
Set fc = f.SubFolders
For Each f1 in fc
Set ff = fso.GetFolder(f1)
DelFiles(ff)
DelSubFolders(ff)

if f1.size = 0 then
f1.delete
end if
Next

End Function

Set fso = CreateObject("Scripting.FileSystemObject")

Share = "D:\Common"

DelFiles(Share)
DelSubFolders(Share)

Когда я заменил Share = "D:\Common" на Share = "%USERPROFILE%\Мои документы\Downloads" получаю ошибку:

C:\Program Files\Support Tools>cscript "C:\Documents and Settings\olga\Рабочий с
тол\TMP\test_chrom_download.vbs"
Сервер сценариев Windows (Microsoft R) версия 5.7
c Корпорация Майкрософт (Microsoft Corp.), 1996-2001. Все права защищены.

C:\Documents and Settings\olga\Рабочий стол\TMP\test_chrom_download.vbs(7, 1) Ош
ибка выполнения Microsoft VBScript: Путь не найден


Папка C:\Documents and Settings\olga\Мои документы\Downloads есть.
Что-то не так с переменной среды %USERPROFILE%?

Понял, что проблема с русскими буковками в адресе. Надо переделывать скрипт, чтобы работал и на win xp, и на win vista/7/8/10.

Нашаманил такой код и вроде бы работает, как задумано:
Код:
Dim fso
Dim WshShell, OsVer

Function DelFiles(Folder)
'*** ”г­ЄжЁп г¤ «пҐв ўбҐ д ©«л ў Ї ЇЄҐ Folder бв аиҐ N ¤­Ґ©

N = 1
Set f = fso.GetFolder(Folder)

Set fc = f.Files
For Each f1 in fc
Set file = fso.GetFile(f1)
diff = DateDiff("d", file.DateCreated, date,0, 0)
If diff > N Then
file.delete
end if
Next

End Function

Function DelSubFolders(SubFolder)
'*** ”г­ЄжЁп ЇҐаҐЎЁа Ґв Ї®¤Ї ЇЄЁ ў Ї ЇЄҐ SubFolder,
'*** ўл§лў Ґв дг­ЄжЁо г¤ «Ґ­Ёп д ©«®ў Ё г¤ «пҐв ЇгбвлҐ Ї®¤Ї ЇЄЁ

'Dim f, f1, fc, ff, ff1, fc1, file, diff

Set f = fso.GetFolder(SubFolder)
Set fc = f.SubFolders
For Each f1 in fc
Set ff = fso.GetFolder(f1)
DelFiles(ff)
DelSubFolders(ff)

if f1.size = 0 then
f1.delete
end if	
Next
End Function

' dalee
' proverka nalichiya papki downloads, esli net popli, to vyhod iz skripta
' proverka operacionnoi sistemy, ot etogo zavisyat puti k papke downloads



Set WshShell = CreateObject("WScript.Shell")
OsVer = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("WScript.Shell")
If OsVer = "5.1" Then
	Share = WSHShell.SpecialFolders("MyDocuments")
	Share = Share & "\Downloads"
		If fso.FolderExists(Share) Then

		Else
			WScript.Quit
		End if 

Else
	strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
	Share = strHomeFolder & "\Downloads"
		If fso.FolderExists(Share) Then

		Else
			WScript.Quit
		End if 
End If

DelFiles(Share)
DelSubFolders(Share)
Для вин server2003 и для 2000/98/95 скорей всего не будет работать. На них не тестировал.

Последний раз редактировалось Lyuker; 10.08.2015 в 13:54.. Причина: обновил код, добавил новое условие
Lyuker вне форума
 
Ответить с цитированием Вверх
 
Время генерации страницы 0.08159 секунды с 9 запросами