[VB6, VBA] funkcja Dir

[paweł]

Witam,
Stosując przykład z helpa dla funkcji DIR wylistowuję przy pomocy pętli
wszystkie katalogi. Potem dla każdego katalogu robię to samo w celu
wylistowania zawartych w nich plików.
Czy jest możliwe wykonanie powyższego jednocześnie, tzn. w trakcie
wykonywania pętli uzyskuję i nazwy katalogów i zawartych w nich plików?
Zbiory musze uzyskać ww. funkcją.

Z góry dziękuję
Paweł

[Any User]

Post by paweł
Stosując przykład z helpa dla funkcji DIR wylistowuję przy pomocy pętli
wszystkie katalogi. Potem dla każdego katalogu robię to samo w celu
wylistowania zawartych w nich plików.
Czy jest możliwe wykonanie powyższego jednocześnie, tzn. w trakcie
wykonywania pętli uzyskuję i nazwy katalogów i zawartych w nich plików?
Zbiory musze uzyskać ww. funkcją.

Spróbuj czegoś takiego:

Private Sub ScanRecurse(oRoot As Scripting.Folder, intInside As Integer)
On Error Resume Next
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.File

For Each oFile In oRoot.Files
m_Files.Add (oFile.Path)
Next

If intInside = 1 Then
For Each oSubFolder In oRoot.SubFolders
ScanRecurse oSubFolder, intInside
Next
End If
End Sub

[paweł]

Post by Any User
Private Sub ScanRecurse(oRoot As Scripting.Folder, intInside As Integer)
On Error Resume Next
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.File
For Each oFile In oRoot.Files
m_Files.Add (oFile.Path)
Next
If intInside = 1 Then
For Each oSubFolder In oRoot.SubFolders
ScanRecurse oSubFolder, intInside
Next
End If
End Sub

Zależy mi jednak na rozwiazaniu przy pomocy funkcji Dir ;)

Pozdrawiam
Paweł

[Tajan]

Witam!

Post by paweł
Zależy mi jednak na rozwiazaniu przy pomocy funkcji Dir ;)

Kiedyś, do listowania plików Excela, używałem takiej, prostej procedury:

Sub listujPliki()

Application.Cursor = xlWait

SzukajPlikow "c:\dane", "*.xls", 2

Application.Cursor = xlDefault

End Sub


Sub SzukajPlikow(Sciezka As String, plik As String, wiersz As Long)
Dim colDirNames As New Collection
Dim strDirName As String
Dim i As Long

If Right(Sciezka, 1) <> "\" Then
Sciezka = Sciezka & "\"
End If

strDirName = Dir(Sciezka & "*.*", vbDirectory)

Do While Len(strDirName) > 0

If (strDirName <> ".") And (strDirName <> "..") Then
If (GetAttr(Sciezka & strDirName) And vbDirectory) Then

colDirNames.Add strDirName

ElseIf strDirName Like plik Then

ActiveSheet.Cells(wiersz, 1) = Sciezka & strDirName
wiersz = wiersz + 1
End If
End If

strDirName = Dir()
DoEvents
Loop

If colDirNames.Count > 0 Then
For i = 1 To colDirNames.Count
SzukajPlikow Sciezka & colDirNames(i), plik, wiersz
Next
End If

End Sub

Zwróć jednak uwagę, że nazwę pliku sprawdzam przy pomocy operatora Like,
więc maska nazwy plików powinna zgodna z regułami dla tego operatora, a nie
dla funkcji Dir (chociaż w większości przypadków będzie to raczej to samo).


Tajan

[paweł]

Tak to sobie wyobrażałem. Wielkie dzieki.

Pozdrawiam
Paweł