как узнат какие файлы находатса в определоной папке?

[Doctor Nestor]

Рекурсивный подход (by Evangelos Petroutos)

Код: Выделить всё

Sub ScanNode(aNode As Node)
' This subroutine scans a node recursively.
' It adds the child nodes of the current node to
' the ListBox control on the right
' Child nodes are indented according to their
' position in the tree structure
Dim thisNode As Node
Dim i As Long
Static RDepth As Integer

'   Add current node to the ListBox control
    List1.AddItem Space(RDepth * 10) & aNode.Text
'   If the node has child nodes, increase indentation depth and scan all
'   child nodes, including their child nodes by calling ScanNode() recursively
    If aNode.Children > 0 Then
        RDepth = RDepth + 1
        Set thisNode = aNode.Child
        For i = 1 To aNode.Children
            ScanNode thisNode
            Set thisNode = thisNode.Next
        Next
        RDepth = RDepth - 1
    End If
End Sub


[RayShade]

Ну и чем же этот код попомжет решению поставленной задачи? Может быть, стоит немного анализировать то, что постим?

[Doctor Nestor]

Я не слепой ... я кривой.
Ну не тот код прилепил ... и что??? Идея та же

Код: Выделить всё

Sub ScanFolders()
Dim subFolders As Integer

    totalFiles = totalFiles + File1.ListCount
    subFolders = Dir1.ListCount
    If subFolders > 0 Then
        For i = 0 To subFolders - 1
            ChDir Dir1.List(i)
            Dir1.Path = Dir1.List(i)
            File1.Path = Dir1.List(i)
            Form1.Refresh
            ScanFolders
        Next
    End If
    File1.Path = Dir1.Path
    MoveUp
End Sub


[Doctor Nestor]

продолжение

Код: Выделить всё


Sub MoveUp()
    If Dir1.List(-1) <> InitialFolder Then
        ChDir Dir1.List(-2)
        Dir1.Path = Dir1.List(-2)
    End If
End Sub


[Doctor Nestor]

продолжение

Код: Выделить всё


Sub MoveUp()
    If Dir1.List(-1) <> InitialFolder Then
        ChDir Dir1.List(-2)
        Dir1.Path = Dir1.List(-2)
    End If
End Sub


[Doctor Nestor]

Или вот ещё

Код: Выделить всё

Sub ScanFolders()
Dim subFolders As Integer
Dim txtLine As String
Dim i As Integer, j As Integer

    txtLine = ""
    For j = 0 To File1.ListCount - 1
        txtLine = txtLine & Space(currentDepth * 5) + File1.List(j) & newLine
    Next
    totalFiles = totalFiles + File1.ListCount
    DirStructure = DirStructure & txtLine

    subFolders = Dir2.ListCount
    If subFolders > 0 Then
        currentDepth = currentDepth + 1
        For i = 0 To subFolders - 1
'msgbox "moving from " & CurDir & " to " & Dir2.List(i)
            DirStructure = DirStructure & "{\b " & DoubleSlashes(Dir2.List(i)) & "}" & newLine
            File1.Path = Dir2.List(i)
            ChDir CurDir
            Dir2.Path = Dir2.List(i)
            ScanFolders
        Next
        totalFolders = totalFolders + subFolders
        Label1.Caption = "Processed " & totalFolders & " folders"
        currentDepth = currentDepth - 1
        DoEvents
    End If
    MoveUp
    File1.Path = Dir2.Path
End Sub

Sub MoveUp()
    If Dir2.List(-1) <> InitialFolder Then
        ChDir Dir2.List(-2)
        Dir2.Path = Dir2.List(-2)
    End If
End Sub


Всё та же идея/ первый раз малость промахнулся

[RayShade]

Вот тепреь все более менее прилично

[CodeName33]

А вот так можно без всякиз DirListBox'ов. Все файлы внутри папки и её подпапок с полными путями сохраняются в массив String и функция возвращает количество файлов:

Public Function GetSubFolderFiles(ByVal Folder As String, FilesArray() As String) As Long
Dim i As Long, ArrayF() As String, ArrayC As Long, S2 As String, cDir As Long, cSize As Long, S As String
ReDim ArrayF(1 To 1) As String
ArrayC = 1: cDir = 1
ArrayF(ArrayC) = DirFilterIN(Folder) + "\"

GETFOLDERS:
Folder = DirFilterIN(Folder) + "\"
S = Dir(Folder, vbDirectory Or vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
Do Until S = ""
If Not StrComp(S, ".") = 0 And Not StrComp(S, "..") = 0 Then
S2 = Folder + S
If (GetAttr(S2) And vbDirectory) = vbDirectory Then
ArrayC = ArrayC + 1
ReDim Preserve ArrayF(1 To ArrayC) As String
ArrayF(ArrayC) = S2
Else
GetSubFolderFiles = GetSubFolderFiles + 1
ReDim Preserve FilesArray(1 To GetSubFolderFiles) As String
FilesArray(GetSubFolderFiles) = S2
End If
End If
S = Dir
Loop

If cDir < ArrayC Then
cDir = cDir + 1
Folder = ArrayF(cDir)
GoTo GETFOLDERS
End If
End Function

Public Function DirFilterIN(DirName As String) As String
On Error Resume Next
If Mid$(DirName, Len(DirName), 1) = "\" Then
DirFilterIN = Mid$(DirName, 1, Len(DirName) - 1)
Else
DirFilterIN = DirName
End If
End Function

[TEH3OP]

Просто у меня похожая задачка была... надо было список файлов в папке получить (причём в папке были тока файлы).
Мож интересно буит...
Это резанутый и подкорректированный код из API Guide.

Код: Выделить всё

Public Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

Public Const MAX_PATH As Long = 260

Public Const FIND_CINTERIA As String = "*.doc"

Public Const INVALID_HANDLE_VALUE = -1

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public 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

Private Sub FindFilesAPI(ByVal iPath As String, ByVal iCinteria As String, ByRef oFileNames() As String, ByRef oMaxIdx As Long)

    Dim bstFileName As String
    Dim lngFileCount As Long
    Dim lngAPIReturn As Long
    Dim bstPath As String
    Dim bstCinteria As String
    Dim abstFileNames() As String
    Dim lngHSearch As Long
    Dim udtWFD As WIN32_FIND_DATA
   
    bstCinteria = iCinteria
    bstPath = iPath
       
    lngHSearch = INVALID_HANDLE_VALUE
    lngHSearch = FindFirstFile(bstPath & iCinteria, udtWFD)
    lngFileCount = -1&
       
    If lngHSearch <> INVALID_HANDLE_VALUE Then
        Do
            bstFileName = VBA.Replace(udtWFD.cFileName, vbNullChar, vbNullString)
            If (bstFileName <> ".") And (bstFileName <> "..") Then
                lngFileCount = lngFileCount + 1
                ReDim Preserve abstFileNames(0& To lngFileCount) As String
                abstFileNames(lngFileCount) = bstFileName
            End If
            lngAPIReturn = FindNextFile(lngHSearch, udtWFD)
        Loop Until lngAPIReturn = 0&
        FindClose lngHSearch
    End If

    'Возвращаем значение.
    oFileNames = abstFileNames
    oMaxIdx = lngFileCount
End Sub


Папки от файлов отличить мона через тот же GetAttr.

[tyomitch]

2TEH3OP: а чем это лучше простого Dir-a?

[alibek]

tyomitch, да просто уж очень тормозная эта Dir$(), через API раза в 2-3 быстрее будет.