| Вопрос: Список файлов из указанной папки | Добавлено: 12.05.05 13:32 |
Автор вопроса:  Diz | Web-сайт: www.TS-Group.fatal.ru
|
|
Как получить список файлов из указанной папки? например:
мне из D:\2\ нужны все файлы с расширением psd |
| Ответы | Всего ответов: 7 |
|
Номер ответа: 1 Автор ответа:  User Unknown Вечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302 |
Профиль | | #1 | Добавлено: 12.05.05 13:37 |
|
Private Function AllFiles(ByVal FullPath As String) _ As String() '*************************************************** 'PURPOSE: Returns all files in a folder using 'the FileSystemObject 'PARAMETER: FullPath = FullPath to folder for 'which you want all files 'RETURN VALUE: An array containing a list of 'all file names in FullPath, or a 1-element 'array with an empty string if FullPath 'does not exist or it has no files 'REQUIRES: Reference to Micrsoft Scripting ' Runtime 'EXAMPLE: 'Dim sFiles() as string 'dim lCtr as long 'sFiles = AllFiles("C:\Windows\System" 
'For lCtr = 0 to Ubound(sFiles) '  ebug.Print sfiles(lctr)
'Next 'REMARKS: The FileSystemObject does not 'Allow for the use of wild cards (e.g., '*.txt.) If this is what you need, see 'http://wwww.freevbcode.com/ShowCode.asp?ID=1331 '************************************************ Dim oFs As New FileSystemObject Dim sAns() As String Dim oFolder As Folder Dim oFile As File Dim lElement As Long ReDim sAns(0) As String If oFs.FolderExists(FullPath) Then Set oFolder = oFs.GetFolder(FullPath) For Each oFile In oFolder.Files lElement = IIf(sAns(0) = "", 0, lElement + 1) ReDim Preserve sAns(lElement) As String sAns(lElement) = oFile.Name Next End If AllFiles = sAns ErrHandler: Set oFs = Nothing Set oFolder = Nothing Set oFile = Nothing End Function http://vbnet.ru/faq/showfaqgroup.asp?id=10 |
||
|
Номер ответа: 2 Автор ответа:  KEP Вопросов: 44 Ответов: 119 |
Профиль | | #2 | Добавлено: 12.05.05 17:17 |
|
Dim c As Collection
Set c = FindFiles("*.sav", App.Path & "\Data\Save"
MsgBox c.Count Dim i As Long For i = 1 To c.Count L.AddItem c.Item(i) Next |
||
|
Номер ответа: 3 Автор ответа: Diz Вопросов: 24 Ответов: 38 |
Web-сайт: Профиль | | #3 | Добавлено: 13.05.05 07:49 |
| вот 2 вариант мне больше понравился, но он ругается когда доходит до FindFiles может такого небыло в VB5 ??? | ||
|
Номер ответа: 4 Автор ответа: KEPВопросов: 44 Ответов: 119 |
Профиль | | #4 | Добавлено: 13.05.05 11:19 |
|
Блин забыл... к
Dim c As Collection Set c = FindFiles("*.sav", App.Path & "\Data\Save"
MsgBox c.Count Dim i As Long For i = 1 To c.Count L.AddItem c.Item(i) Next в модуль-> Option Explicit Public Const MAX_PATH = 260 Public Const UnicodeTypeLib = True Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal sDrive As String) As Long Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Public Function FindFiles(sTarget As String, Optional _ ByVal Start As String) As Collection Dim AB() As Byte Static TypeDrev As String Dim hFiles As Long, f As Boolean Static sName As String, sSpec As String, nFound As New Collection Static fd As WIN32_FIND_DATA, iLevel As Long Dim sEmpty, INVALID_HANDLE_VALUE If Start = sEmpty Then Start = CurDir$ 'Maintain level to ensure collection is cleared first time If iLevel = 0 Then Set nFound = Nothing Start = NormalizePath(Start) End If iLevel = iLevel + 1 'Find first file (get handle to find) hFiles = FindFirstFile(Start & "*.*", fd) f = (hFiles <> INVALID_HANDLE_VALUE) o While f
AB = fd.cFileName sName = ByteZToStr(AB) 'Skip . and .. If Left$(sName, 1) <> "." Then sSpec = Start & sName If fd.dwFileAttributes And vbDirectory Then 'Call recursively on each directory oEvents
FindFiles sTarget, sSpec & "\" Else If InStr(sTarget, "*" > 0 Then
If StrComp(Right$(sName, 3), Right$(sTarget, 3), 1) = 0 Then ' Text comparison 'Store found files in collection nFound.Add sSpec ElseIf StrComp(sName, sTarget, 1) = 0 Then ' Text comparison 'Store found files in collection nFound.Add sSpec End If End If End If End If 'Keep looping until no more files f = FindNextFile(hFiles, fd) Loop f = FindClose(hFiles) 'Return the matching files in collection Set FindFiles = nFound iLevel = iLevel - 1 End Function Function ByteZToStr(AB() As Byte) As String If UnicodeTypeLib Then ByteZToStr = AB Else ByteZToStr = StrConv(AB, vbUnicode) End If ByteZToStr = Left$(ByteZToStr, lstrlen(ByteZToStr)) End Function Function NormalizePath(sPath As String) As String If Right$(sPath, 1) <> "\" Then NormalizePath = sPath & "\" Else NormalizePath = sPath End If End Function |
||
|
Номер ответа: 5 Автор ответа: MihalыchICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #5 | Добавлено: 13.05.05 13:18 |
|
Ну порадовали…
2KEP, а слона то мы и не заметили… 2Diz, а теперь наверное тебе больше нравится первый вариант… З.Ы. Без обид просто прикольно получилось. |
||
|
Номер ответа: 6 Автор ответа: DizВопросов: 24 Ответов: 38 |
Web-сайт: Профиль | | #6 | Добавлено: 13.05.05 15:13 |
|
Да нет, всё ОК... только путь приходится обрезать... а так второй вариант ништяк... только кто объяснит. я создал Modul 2, вставил код, запустил работает. А затем модуль 2 переименовал в другой и
всё перестало работать... надо его заюзать где-то шоли??? |
||
|
Номер ответа: 7 Автор ответа: MihalыchICQ: 373-509-101 Вопросов: 56 Ответов: 330 |
Профиль | | #7 | Добавлено: 13.05.05 15:47 |
| Если ты переименовал сам файл модуля, тогда открой в блокноте файл проекта (*.vbp), и везде где найдешь старое имя файла замени на новое. | ||
Страница: 1 |