Batya
|
 Posted: Mon Feb 07, 2022 13:27 Post subject: |
 |
|
| Urrih wrote: | | Подскажите, что изменить, чтобы поиск осуществлялся еще и во вложенным директориям т. е. рекурсивно. |
Уф... "Давно не брал я шашки в руки" (с)
Есть нюансы по постановке задачи. Возможно, вот это подойдёт:
| Code: | '=========================================================================
' Проверка существования файлов\папок, представленных в файле-списке.
' Результат действия скрипта - формируемся итоговый файл-список
' с отсутствующими файлами\папками
'
' Параметры:
' {исходный файл-список} {итоговый файл-список}
'
' Автор - Batya
'=========================================================================
Option Explicit
'======== Изменяемые параметры ===========================================
Const FolderCheck = True 'Проверять ли папки
Const FileCheck = True 'Проверять ли файлы
Const Existing = False 'Что помещать в итоговый файл
'=========================================================================
Dim Mess, FSO, WSH, FF1, FF2, F, FRet, TFL, List
SetMess
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
CheckParam
For Each F In Split(FSO.OpenTextFile(FF1).ReadAll, vbNewLine)
If F <> "" Then
F = GetPath(F)
FRet = ExistsCheck(F)
If Not Existing Then
If FRet = "" Then
FRet = F
Else
FRet = ""
End If
End If
If FRet <> "" Then List = List & vbNewLine & FRet
End If
Next
If List <> "" Then List = Mid(List, Len(vbNewLine) + 1)
On Error Resume Next
Set TFL = FSO.CreateTextFile(FF2, True)
If Err.Number <> 0 Then
MessBox Mess(5) & vbNewLine & Err.Description, 1
Err.Clear
Quit
End If
TFL.Write List
If Err.Number <> 0 Then
MessBox Mess(5) & vbNewLine & Err.Description, 1
Err.Clear
Quit
End If
On Error GoTo 0
MessBox Mess(4), 3
Quit
Sub SetMess
Set Mess = CreateObject("Scripting.Dictionary")
With Mess
.Add 0, "Проверка существования файлов\папок"
.Add 1, "Не указаны параметры!"
.Add 2, "Первый параметр не является файлом-списком!"
.Add 3, "Не указан итоговый файл-список!"
.Add 4, "Операция завершена."
.Add 5, "Операция прервана по причине ошибки:"
End With
End Sub
Sub CheckParam
If WScript.Arguments.Count = 0 Then
MessBox Mess(1), 1
Quit
End If
FF1 = GetPath(WScript.Arguments(0))
If Not FSO.FileExists(FF1) Then
MessBox Mess(2), 1
Quit
End If
If WScript.Arguments.Count = 1 Then
MessBox Mess(3), 1
Quit
End If
FF2 = GetPath(WScript.Arguments(1))
End Sub
Function GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function
Function ExistsCheck(pPath)
Dim lRet, lFF, lF
lRet = ""
If (lRet = "") And FolderCheck And FSO.FolderExists(pPath) Then
lRet = pPath
End If
If (lRet = "") And FileCheck And FSO.FileExists(pPath) Then
lRet = pPath
End If
If lRet = "" Then
If FSO.FolderExists(pPath) Then
lFF = pPath
Else
lFF = FSO.GetParentFolderName(pPath)
End If
For Each lF In FSO.GetFolder(lFF).SubFolders
lRet = ExistsCheck(lF.Path & "\" & FSO.GetFileName(pPath))
If lRet <> "" Then Exit For
Next
End If
ExistsCheck = lRet
End Function
Function MessBox(pMess, pMode)
Dim lIcon
Select Case pMode
Case 1 lIcon = vbCritical + vbOKOnly
Case 2 lIcon = vbExclamation + vbOKOnly
Case 3 lIcon = vbInformation + vbOKOnly
End Select
MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function
Sub Quit
Set Mess = Nothing
Set WSH = Nothing
Set TFL = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
