То есть сканирование всех внешних носителей.]]>
RecourseDeleteByMask shell.GetFolder("C:\"), "*.$$$"
RecourseDeleteByMask shell.GetFolder("D:\"), "*.$$$"
RecourseDeleteByMask shell.GetFolder("E:\"), "*.$$$"возможно?
]]> Тогда без вариантов, дабы избежать плясок с бубном — надо перенести команду удаления внутрь «On Error…» и добавить сразу после неё Err.Clear.
]]> If objFSO.FileExists(strFullMask) Then
objFSO.DeleteFile strFullMask, True ' Удаляем файлы по маске.
End Ifне работает вообще
]]>после цикла лучше поставить smile
Разве от этого скрипт падать перестанет (если убрать On Error Resume Next)? Посему такой вариант мне не нравится.
]]>Remarks
An error occurs if no matching files are found. …
Тогда, думаю, следует поменять логику таким образом, с:
objFSO.DeleteFile strFullMask, True ' Удаляем файлы по маске.на:
If objFSO.FileExists(strFullMask) Then
objFSO.DeleteFile strFullMask, True ' Удаляем файлы по маске.
End Ifпосле цикла лучше поставить
Option Explicit
Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
RecourseDeleteByMask objFSO.GetFolder("D:\111111"), "*.cdx"
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMask)
Dim objSubFolder
Dim strFullMask
WScript.Echo objFolder.Path ' Выводим путь обрабатываемой папки (для
' отладки; имеет смысл закомментировать).
strFullMask = objFSO.BuildPath(objFolder.Path, strMask) ' Строим полный путь.
On Error Resume Next ' Обрабатываем ошибки, возможные в случае,
' когда нет доступа к содержимому папки
' (пример - «System Volume Information».
For Each objSubFolder In objFolder.SubFolders
If Err.Number = 0 Then ' Удалось получить доступ к содержимому папки?
RecourseDeleteByMask objSubFolder, strMask ' Вызываем процедуру для каждой из подпапок.
Else ' Если не удалось —
Err.Clear ' сбрасываем состояние ошибки и движемся дальше.
WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
End If
Next
objFSO.DeleteFile strFullMask, True ' Удаляем файлы по маске.
On Error Goto 0 ' Восстанавливаем стандартную обработку ошибок
End SubOption Explicit
Dim objFSO
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
RecourseDeleteByMask objFSO.GetFolder("D:\111111"), "*.cdx"
Set objFSO = Nothing
WScript.Quit 0
'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMask)
Dim objSubFolder
Dim strFullMask
WScript.Echo objFolder.Path ' Выводим путь обрабатываемой папки (для
' отладки; имеет смысл закомментировать).
strFullMask = objFSO.BuildPath(objFolder.Path, strMask) ' Строим полный путь.
objFSO.DeleteFile strFullMask, True ' Удаляем файлы по маске.
On Error Resume Next ' Обрабатываем ошибки, возможные в случае,
' когда нет доступа к содержимому папки
' (пример - «System Volume Information».
For Each objSubFolder In objFolder.SubFolders
If Err.Number = 0 Then ' Удалось получить доступ к содержимому папки?
RecourseDeleteByMask objSubFolder, strMask ' Вызываем процедуру для каждой из подпапок.
Else ' Если не удалось —
Err.Clear ' сбрасываем состояние ошибки и движемся дальше.
WScript.Echo "Can't enumerate subfolders for folder [" & objFolder.Path & "]."
End If
Next
On Error Goto 0 ' Восстанавливаем стандартную обработку ошибок
End SubRecourseDeleteByMask objFSO.GetFolder("D:\111111"), "*.cdx"
RecourseDeleteByMask objFSO.GetFolder("D:\111111"), "*.dbf"Или надо менять саму функцию «RecourseDeleteByMask» для поддержки множественных масок.
]]>RecourseDeleteByMask objFSO.GetFolder("D:\111111"), "*.cdx, *.dbf"то он ругается вот на эту строку.
objFSO.DeleteFile strFullMask, TrueНе может найти файл.
]]>