| |
|
|
| |
Private Declare Function apiSearchTreeForFile Lib "ImageHlp.dll" Alias _
"SearchTreeForFile" (ByVal lpRoot As String, ByVal lpInPath _
As String, ByVal lpOutPath As String) As Long
Function fSearchFile(ByVal strFilename As String, _
ByVal strSearchPath As String) As String
'Returns the first match found
Dim lpBuffer As String
Dim lngResult As Long
fSearchFile = ""
lpBuffer = String$(1024, 0)
lngResult = apiSearchTreeForFile(strSearchPath, strFilename, lpBuffer)
If lngResult <> 0 Then
If InStr(lpBuffer, vbNullChar) > 0 Then
fSearchFile = Left$(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
End If
End If
End Function
|
Этот код поиска предложил Анатолий (Киев).
Прекрасно работает, но вот возникла необходимость искать не по полному названию.с расширением.
А заменить на *.* - не удаётся сделать..
Или (текс*.*)
Помогите пожалуйста... | |
| |
| |
| |
|
|
| | Да и Текст.txt<>текст.txt | |
| |
| |
| |
|
|
| | Простого способа нет. Нужно получить список вложенных папок и искать файлы в каждой.
С помощью FSO получить такой список несложно. Вот функция:
Function GetSubfolderList(sTopFolder As String, col As Collection) As Long
'Возвращает количество папок, вложенных в sTopFolder, а в аргументе col - коллекцию
' путей ко всем этим папкам.
On Error Resume Next
Dim fso As Object 'FileSystemObject
Dim fd As Object 'Folder
Dim fds As Object 'Folders
If col Is Nothing Then Set col = New Collection
Set fso = CreateObject("Scripting.FileSystemObject")
If Err <> 0 Then Err.Clear: GoTo Func_exit
If Not fso.FolderExists(sTopFolder) Then GoTo Func_exit
Set fd = fso.GetFolder(sTopFolder)
Set fds = fd.SubFolders
For Each fd In fds
'Добавляем путь к папке в коллекцию
col.Add fd.Path
'Рекурсивно вызываем эту же функцию для получения дочерних папок
Call GetSubfolderList(fd.Path, col)
Next
Func_exit:
GetSubfolderList = col.Count
Set fd = Nothing: Set fds = Nothing: Set fso = Nothing
End Function
|
А вот функция поиска всех файлов или первого:
Function SearchTree(ByVal sTopFolder As String, ByVal sFileSpec As String, _
Optional fFirstOnly As Boolean) As String
'Ищет в папке sTopFolder и вложенных папках файл(ы) по маске в sFileSpec.
'Возращает путь первому найденному файлу (fFirstOnly=True) или список всех найденных,
' разделенных символом ";".
Dim fds As Collection, i As Long
Dim sFolder As String, sFile As String, sFiles As String
sFolder = Trim$(sTopFolder)
If Len(sFolder) = 0 Or Len(Trim$(sFileSpec)) = 0 Then Exit Function
If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
'Выполняется поиск в родительсой папке
GoSub SearchFiles
'Создает коллекцию вложенных папок
Call GetSubfolderList(sTopFolder, fds)
For i = 1 To fds.Count
'Выполняется поиск во вложенных папках
sFolder = fds(i) & "\": GoSub SearchFiles
Next
SearchTree = Mid$(sFiles, 2): GoTo Func_exit
SearchFiles:
'Подпрограмма поиска файлов.
sFile = Dir(sFolder & sFileSpec)
Do While Len(sFile) > 0
If fFirstOnly Then SearchTree = sFolder & sFile: GoTo Func_exit
sFiles = sFiles & ";" & sFolder & sFile
sFile = Dir
Loop
Return
Func_exit:
Set fds = Nothing
End Function
|
Полученную стоку можно преобразовать в массив функцией Split.
>Да и Текст.txt<>текст.txt
Это уже архитектурное излишешество. 
Получите все, а затем - сравнивайте.
ЗЫ. Честно говоря, эту функцию собирался написать давно, а взялся только сегодня, прочитав ваш вопрос. Так что - цените!  | |
| |
| |
|
|
| |
|
|
| | >А FSO B runtime не работает?
Почему не работает? В Win 98 FSO может и не быть, а в остальном...
Ссылка на библиотеку не нужна, используются объектные переменные, вызывается так:
Set fso = CreateObject("Scripting.FileSystemObject")
Чего б ей не работать... | |
| |
| |
|
|
