Страницы: 1
RSS
Удаление файлов с помощью XL
 
есть диск Е  
в нём папка 1  
чтобы её очистить от файлов, я запускаю книгу XL  
 
в этой книге код:  
Sub del()  
On Error Resume Next  
Kill ("e:\1\*.*")  
Application.Quit  
End Sub  
 
а в модуле ЭтаКнига такой код:  
Private Sub Workbook_Open()  
del  
End Sub  
 
Но как-то удалять файлы с помощью XL...  :-)  
 
Может кто напишет VB скрипт?
 
Я пользуюсь таким vbs скриптом для удаления мусора при старте системы - его легко изменить под другие условия (путь исправьте на нужный:  
 
'Удаление файлов XLS если они старше n дней    
Dim FSO ', WSH  
Dim TheFolder, TheFiles, AFile  
'Set WSH = CreateObject("WScript.Shell")  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set TheFolder = FSO.GetFolder("D:\1\") 'Каталог, откуда удалять  
Set TheFiles = TheFolder.Files  
'msgbox "I Delete Old EXCEL files!"  
For Each AFile In TheFiles  
   If UCase(FSO.GetExtensionName(AFile.Path)) = "XLS" and _    
       DateDiff("d", AFile.DateLastModified, Date) > 10  Then  
       AFile.Delete  
   End If  
Next
 
У самого мусор в коде остался :(  
 
Ну тогда уж так укорочу:  
 
'Удаление файлов XLS если они старше n дней    
Dim AFile  
with CreateObject("Scripting.FileSystemObject")  
For Each AFile In .GetFolder("D:\1\").Files  
   If UCase(.GetExtensionName(AFile.Path)) = "XLS" and _    
       DateDiff("d", AFile.DateLastModified, Date) > 10  Then  
       AFile.Delete  
   End If  
Next  
end with
 
Мне нужно чтобы очистил папку e:\1\ и нужно чтобы удалил файлы с любыми форматами, не смотря на дату изменения или дату создания файла (ну тупо надо очистить папку и всё)  
Пожтому переделал на это:  
 
Dim FSO ', WSH  
Dim TheFolder, TheFiles, AFile  
'Set WSH = CreateObject("WScript.Shell")  
Set FSO = CreateObject("Scripting.FileSystemObject")  
Set TheFolder = FSO.GetFolder("e:\1\") 'Каталог, откуда удалять  
Set TheFiles = TheFolder.Files  
'msgbox "I Delete Old EXCEL files!"  
For Each AFile In TheFiles  
If UCase(FSO.GetExtensionName(AFile.Path)) = "*" Then AFile.Delete  
Next  
 
НО НЕ РАБОТАЕТ может дело в этом - * ?
 
Зачем тогда условие  
If UCase(FSO.GetExtensionName(AFile.Path)) = "*" Then    
?  
Просто    
For Each AFile In TheFiles  
AFile.Delete  
Next  
 
Итого:  
 
Dim AFile  
with CreateObject("Scripting.FileSystemObject")  
For Each AFile In .GetFolder("D:\1\").Files:  AFile.Delete:Next  
end with
 
Да и вообще тогда одной строки достаточно:  
 
For Each f In CreateObject("Scripting.FileSystemObject").GetFolder("E:\1\").Files: f.Delete:Next
 
Вот окончательный вариант  
 
Dim AFile  
with CreateObject("Scripting.FileSystemObject")  
For Each AFile In .GetFolder("e:\1\").Files  
AFile.Delete  
Next  
end with  
 
РАБОТАЕТ  
 
НО - если есть файлы со статусом "только для чтения", то дает ошибку и останавливается, то есть не удаляет другие файлы.  
 
А нужно чтобы не останавливался и удалил всё что можно  
Надо добавить на самом верху On Error Resume Next ?
 
Пытался подобрать как изменить атрибут - не получилось, нужно хелп читать :)  
Но on error resume next конечно поможет, но readonly останутся.
 
всё отлично работает  
удаляет всё за исключением ТолькоДляЧтения  
 
СПАСИБО
 
Тут нашёл про атрибуты:  
<EM>http://blogs.technet.com/b/heyscriptingguy/archive/2004/10/19/how-can-i-change-a-read-only-file-to-a-read-write-file.aspx  
</EM>
 
 
Const ReadOnly = 1  
 
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objFolder = objFSO.GetFolder("C:\Scripts")  
Set colFiles = objFolder.Files  
 
For Each objFile in colFiles  
   If objFile.Attributes AND ReadOnly Then  
       objFile.Attributes = objFile.Attributes XOR ReadOnly  
   End If  
Next
 
Итого:  
 
For Each f In CreateObject("Scripting.FileSystemObject").GetFolder("E:\1\").Files  
If f.Attributes AND 1 Then f.Attributes = f.Attributes XOR 1  
f.Delete  
Next
 
удаляет и readonly файлы тоже  
 
АПЛОДИСМЕНТЫ !
 
Одной строкой, короче:  
 
For Each f In CreateObject("Scripting.FileSystemObject").GetFolder("D:\1\").Files: f.Attributes = 0: f.Delete: Next
 
одной строкой С П А С И Б О: С П А С И Б О: С П А С И Б О: С П А С И Б О  
 
:-)
 
Hugo сегодня разошелся, ващеее (:
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
 
Ну до 10000 ещё далеко... :)
 
А .BAT файл с одной командой не проще?  
 
del /q/f d:\1\
Страницы: 1
Наверх